作者: 芐雨
如何复制当前路径的所有文件到指定文件夹 Sub 复制当前路径的所有文件到指定文件夹_FileCopy() t = Timer Dim 当前路径 As String, 目标路径 As String Dim fs On Error Resume Next 当前路径 = ThisWorkbook.Path & "\" 目标路径 = "C:\汇总数据\" '目标目录 fs = Dir(当前路径 & "*") '如果只复制xls则把 "*" 改成 "*.xls") Do While fs <> "" FileCopy 当前路径 & fs, 目标路径 & fs fs = Dir Loop ActiveWorkbook.SaveCopyAs 目标路径 & ThisWorkbook.Name '*******如果想要对一个已打开的文件使用 FileCopy 语句，则会产生错误****** MsgBox Format(Timer - t, "0.0000") End Sub
方法一：FileCopy
可在VBA中直接引用，单个文件的copy。所以本例中用循环+复制完成。
语法：
FileCopy 源文件名,目标文件名 【两个参数都是必选的,且都包含路径。】
注：如果想要对一个已打开的文件使用 FileCopy 语句，则会产生错误。所以用了 ActiveWorkbook.SaveCopyAs +完整路径
代码：
方法二：CopyFile
需调用FileSystemObject，多个文件可使用通配符。
语法：
| 部分 | 描述 |
| object | 必需的。object始终是一个 FileSystemObject 的名字。 |
| source | 必需的。指明一个或多个要被复制文件的字符串文件说明，它可以包括通配符。 |
| destination | 必需的。指明 source 中的一个或多个文件要被复制到的接受端的字符串，不允许有通配符。 |
| overwrite | 选项的。Boolean 值，它表示存在的文件是否被覆盖。如果是 True，文件将被覆盖；如果是 False，它们不被覆盖。缺省值是 True。注意如果 destination 具有只读属性设置，不论 overwrite 值如何，CopyFile 都将失败。 |
Sub 复制当前路径的所有文件到指定文件夹_CopyFile() t = Timer Dim Fso As Object Dim 当前路径 As String, 目标路径 As String 当前路径 = ThisWorkbook.Path & "\*.*" '如果只复制xls则把 "*.*" 改成 "*.xls" 目标路径 = "C:\汇总数据\" '目标路径 Set Fso = CreateObject("Scripting.FileSystemObject") Fso.CopyFile 当前路径, 目标路径 Set Fso = Nothing MsgBox Format(Timer - t, "0.0000") End Sub
代码：
方法三：XCopy
批处理，shell调用
文中用了 shell Environ("ComSpec")
其中：Environ("ComSpec") 可以获得下列文字"c:\windows\system32\cmd.exe"
语法：
XCOPY source [destination]
| source | 指定要复制的文件。 |
| destination | 指定新文件的位置和/或名称。 |
指定要复制文件也可带通配符。还包含很多参数。XCOPY是COPY的扩展，可以把指定的目录连文件和目录结构一并拷贝，但不能拷贝系统文件。
代码：
Sub 复制当前路径的所有文件到指定文件夹_XCOPY()
t = Timer
Dim 当前路径 As String, 目标路径 As String
当前路径 = ThisWorkbook.Path & "\*.*" '如果只复制xls则把 "*.*" 改成 "*.xls"
目标路径 = "C:\汇总数据\" '目标路径
Shell Environ("comspec") & " /c xcopy " & 当前路径 & " " & 目标路径, vbHide
MsgBox Format(Timer - t, "0.0000")
End Sub
三种方法速度对比
附件中有文件101个，每个约20K左右
FileCopy：约0.3秒
CopyFile：约0.06秒
XCopy: 约0.007秒
使用批处理，超快。
补充：
作者：tmtony
如果文件正在使用中，使用以上方法复制可能会提示 拒绝 70的错误，这个时间要使用API来复制更好
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
CopyFile 源文件, 目标文件, 0
这种方法更保险
