wankoilz

Set fso = WScript.CreateObject("Scripting.Filesystemobject")
If Not fso.FolderExists("D:\dotPath") Then
    fso.CreateFolder("D:\dotPath")
End If
复制代码

wankoilz

Broly兄的代码中有几个地方被忽略了：
1、前面是 Const DocPath="D:\DotPath\" 。fso.CopyFile File.Path,DotPath,True 中的DotPath写错了。
2、fso.GetExtensionName(File.path)="dot"这里应该是doc吧
3、代码中没有创建文件夹的句子。

我想楼主应该可以自行修改吧！

wankoilz

修改你给出的代码：
前提是电脑上有D盘
拷贝doc文件（后缀名是doc还是dot？我有点糊涂了...）

Const DocPath="D:\DocPath\" '此处为你放DOT文件的文件夹，运行前请创建好
Dim fso,Disks 
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(DocPath) Then
    fso.CreateFolder(DocPath)
End If 
Set Disks = fso.Drives 
For Each Disk In Disks 
  If Disk.IsReady And Disk.DriveType = 1 Then 
    Udisk=Disk.DriveLetter & ":\"
    U=True
  End if
Next
If U=True Then
  CopyDocs(Udisk)
Else
  Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  WScript.Quit
End If
WScript.Quit

Sub CopyDocs(path)
  Dim folder,subfolders,Files
  Set folder = fso.getfolder(path)
  Set subfolders = folder.subfolders
  Set Files = folder.Files
  For Each File In Files
    If fso.GetExtensionName(File.path)="doc" Then
      fso.CopyFile File.Path,DocPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyDocs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

PS：我觉得最好征得他人同意后，直接拷更好

wankoilz

我就说咋会有那么明显的错误……