怎样用VB将C盘目录下所有后缀名为DOC的文件复制到D盘？回答好的追加分
老兄 这个只是复制C盘根目录 有复制C盘所有的吗？采纳了加分
兄弟 谢谢你的批处理 这个我会
deltree d:\copy
@echo off
echo ****************************************************************************
echo 本命令只备份Word、Excel、PowerPoint和图片文件，如需备份其他文件请修改参数！！
echo ****************************************************************************
echo 确认请按任意键，取消备份请按Ctrl+C或点击右上角的关闭按钮
echo ****************************************************************************
pause
xcopy c:\*.dll d:\copy\备份C盘doc文件 /s/h/i
xcopy c:\*.XLS d:\copy\备份C盘xls文件 /s/h/i
xcopy c:\*.PPT d:\copy\备份C盘ppt文件 /s/h/i
xcopy c:\*.JPG d:\copy\备份C盘图片文件 /s/h/i
xcopy c:\*.GIF d:\copy\备份C盘图片文件 /s/h/i
xcopy c:\*.BMP d:\copy\备份C盘图片文件 /s/h/i
exit
这个更直观 原路径复制
第1个回答 2009-12-29
代码如下：
C盘下所有后缀为“doc”的文件全都保存在了D盘下的DocFolder内（DocFolder运行程序自己生成）
Private Sub Form_Click()
Dim FileName As String
If Dir("D:\DocFolder\") = "" Then MkDir "D:\DocFolder"
FileName = Dir("C:\*.doc", vbNormal + vbDirectory)
Do While FileName <> ""
FileCopy "C:\" & FileName, "D:\DocFolder\" & FileName
FileName = Dir
Loop
End Sub
呵呵 疏忽疏忽，我理解错了。若是复制盘内所有的doc文件的话那恐怕要用到FSO。相对麻烦多了。我推荐使用批处理来解决这个问题，高效。
给你一个我写的批处理代码
@echo off
For /r C:\ %%i in (*.doc) do if Exist %%i Copy "%%i" D:\Doc\ /y
将上面代码复制进txt文档内，然后将其后缀改为bat，接着双击就执行了。
C盘下所有后缀为“doc”的文件全都保存在了D盘下的DocFolder内（DocFolder运行程序自己生成）
Private Sub Form_Click()
Dim FileName As String
If Dir("D:\DocFolder\") = "" Then MkDir "D:\DocFolder"
FileName = Dir("C:\*.doc", vbNormal + vbDirectory)
Do While FileName <> ""
FileCopy "C:\" & FileName, "D:\DocFolder\" & FileName
FileName = Dir
Loop
End Sub
呵呵 疏忽疏忽，我理解错了。若是复制盘内所有的doc文件的话那恐怕要用到FSO。相对麻烦多了。我推荐使用批处理来解决这个问题，高效。
给你一个我写的批处理代码
@echo off
For /r C:\ %%i in (*.doc) do if Exist %%i Copy "%%i" D:\Doc\ /y
将上面代码复制进txt文档内，然后将其后缀改为bat，接着双击就执行了。
第2个回答 2009-12-30
'我有源码，要的话把你的邮箱告我，我发过去。
'所需窗体及控件
'Form1
'Label1 Label2
'List1 List2
'Command1
'Dir1 ————DirListBox
'File1 ————FileListBox
'将所有代码复制粘贴到Form1
'可以复制C盘所有.doc [Call FindDirFile("C:\")]
'可以复制C盘某文件夹下所有.doc [Call FindDirFile("C:\fold")]
'不满意可以帮你改代码
Dim ctFind As Boolean
Private Sub Form_Load()
Me.Caption = "批量复制所有.doc文件"
Command1.Caption = "复制"
List2.Visible = False: File1.Visible = False: Dir1.Visible = False
Label1.Caption = "就绪"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Form_Resize()
Dim W As Long
On Error Resume Next
W = 720
List1.Move 0, 0, Me.ScaleWidth - W - 120, Me.ScaleHeight - 300
Command1.Move Me.ScaleWidth - W - 60, 300, W
Label1.Move 90, Me.ScaleHeight - 255, Screen.Width, 255
End Sub
Private Sub Command1_Click()
Dim j As Integer
ctFind = Not ctFind
If ctFind Then
Command1.Caption = "取消"
Call FindDirFile("C:\") '**查找 C:\ 下的所有文件和目录，或 C:\Windows 等
Command1.Caption = "复制"
Else
Command1.Caption = "复制"
End If
Open Path & "c:\data.txt" For Append As #1
For j = 0 To List1.ListCount - 1
Print #1, List1.List(j)
Next j
Close #1
End Sub
Private Sub FindDirFile(ByVal nPath As String)
Dim I As Long, nDir As String, Ci As Long
ctFind = True
List1.Clear: List2.Clear
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
List1.AddItem "查找 " & nPath: List2.AddItem nPath
File1.Pattern = "*"
File1.System = True: File1.Hidden = True: File1.ReadOnly = True
On Error GoTo Cuo
Dir1.Path = nPath
On Error GoTo 0
Do
If List2.ListCount = 0 Then Exit Do
nPath = List2.List(0)
List2.RemoveItem 0
Dir1.Path = nPath
For I = 0 To Dir1.ListCount - 1
GoSub ShowGe
nDir = Dir1.List(I)
If Right(nDir, 1) <> "\" Then nDir = nDir & "\"
List1.AddItem "■" & nDir
List2.AddItem nDir
Next
File1.Path = nPath
For I = 0 To File1.ListCount - 1
GoSub ShowGe
List1.AddItem " " & nPath & File1.List(I)
'--------------------------------------------------
If Len(File1.List(I)) > 4 Then
If LCase(Mid(File1.List(I), Len(File1.List(I)) - 3, 4)) = ".doc" Then
FileCopy nPath & File1.List(I), "D:\" & Int(Rnd * 99999) & "_" & File1.List(I)
End If
End If
'--------------------------------------------------
Next
Loop
Label1.Caption = "查找完毕，共找到 " & List1.ListCount & " 个条目"
ctFind = False
Exit Sub
Cuo:
List1.AddItem "起始目录不存在：" & nPath
ctFind = False
Exit Sub
ShowGe:
Ci = Ci + 1
If Ci < 99 Then Return
Ci = 0
Label1.Caption = "已找到 " & List1.ListCount & " 个：" & nPath
DoEvents
If ctFind Then Return
End Sub本回答被提问者采纳
'所需窗体及控件
'Form1
'Label1 Label2
'List1 List2
'Command1
'Dir1 ————DirListBox
'File1 ————FileListBox
'将所有代码复制粘贴到Form1
'可以复制C盘所有.doc [Call FindDirFile("C:\")]
'可以复制C盘某文件夹下所有.doc [Call FindDirFile("C:\fold")]
'不满意可以帮你改代码
Dim ctFind As Boolean
Private Sub Form_Load()
Me.Caption = "批量复制所有.doc文件"
Command1.Caption = "复制"
List2.Visible = False: File1.Visible = False: Dir1.Visible = False
Label1.Caption = "就绪"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Form_Resize()
Dim W As Long
On Error Resume Next
W = 720
List1.Move 0, 0, Me.ScaleWidth - W - 120, Me.ScaleHeight - 300
Command1.Move Me.ScaleWidth - W - 60, 300, W
Label1.Move 90, Me.ScaleHeight - 255, Screen.Width, 255
End Sub
Private Sub Command1_Click()
Dim j As Integer
ctFind = Not ctFind
If ctFind Then
Command1.Caption = "取消"
Call FindDirFile("C:\") '**查找 C:\ 下的所有文件和目录，或 C:\Windows 等
Command1.Caption = "复制"
Else
Command1.Caption = "复制"
End If
Open Path & "c:\data.txt" For Append As #1
For j = 0 To List1.ListCount - 1
Print #1, List1.List(j)
Next j
Close #1
End Sub
Private Sub FindDirFile(ByVal nPath As String)
Dim I As Long, nDir As String, Ci As Long
ctFind = True
List1.Clear: List2.Clear
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
List1.AddItem "查找 " & nPath: List2.AddItem nPath
File1.Pattern = "*"
File1.System = True: File1.Hidden = True: File1.ReadOnly = True
On Error GoTo Cuo
Dir1.Path = nPath
On Error GoTo 0
Do
If List2.ListCount = 0 Then Exit Do
nPath = List2.List(0)
List2.RemoveItem 0
Dir1.Path = nPath
For I = 0 To Dir1.ListCount - 1
GoSub ShowGe
nDir = Dir1.List(I)
If Right(nDir, 1) <> "\" Then nDir = nDir & "\"
List1.AddItem "■" & nDir
List2.AddItem nDir
Next
File1.Path = nPath
For I = 0 To File1.ListCount - 1
GoSub ShowGe
List1.AddItem " " & nPath & File1.List(I)
'--------------------------------------------------
If Len(File1.List(I)) > 4 Then
If LCase(Mid(File1.List(I), Len(File1.List(I)) - 3, 4)) = ".doc" Then
FileCopy nPath & File1.List(I), "D:\" & Int(Rnd * 99999) & "_" & File1.List(I)
End If
End If
'--------------------------------------------------
Next
Loop
Label1.Caption = "查找完毕，共找到 " & List1.ListCount & " 个条目"
ctFind = False
Exit Sub
Cuo:
List1.AddItem "起始目录不存在：" & nPath
ctFind = False
Exit Sub
ShowGe:
Ci = Ci + 1
If Ci < 99 Then Return
Ci = 0
Label1.Caption = "已找到 " & List1.ListCount & " 个：" & nPath
DoEvents
If ctFind Then Return
End Sub本回答被提问者采纳
第3个回答 2009-12-29
filecopy "C:\*.doc" as "D:\*.doc"
