复制当前路径的所有文件到指定文件夹【三种方法】

【引用地址】http://www.exceltip.net/thread-54671-1-1.html

如何复制当前路径的所有文件到指定文件夹

方法一：**FileCopy **
可在VBA中直接引用，单个文件的copy。所以本例中用循环+复制完成。
语法：
FileCopy 源文件名,目标文件名 【两个参数都是必选的,且都包含路径。】

注：如果想要对一个已打开的文件使用 FileCopy 语句，则会产生错误。所以用了 ActiveWorkbook.SaveCopyAs +完整路径

代码：

1. Sub 复制当前路径的所有文件到指定文件夹_FileCopy()

2. t = Timer

3. Dim 当前路径 As String, 目标路径 As String

4. Dim fs

5. On Error Resume Next

6. 当前路径 = ThisWorkbook.Path & ""

7. 目标路径 = "C:\汇总数据" '目标目录

8. fs = Dir(当前路径 & "") '如果只复制xls则把 "" 改成 "*.xls")

9. Do While fs <> ""

10. FileCopy 当前路径 & fs, 目标路径 & fs

11. fs = Dir

12. Loop

13. ActiveWorkbook.SaveCopyAs 目标路径 & ThisWorkbook.Name

14. '*******如果想要对一个已打开的文件使用 FileCopy 语句，则会产生错误******

15. MsgBox Format(Timer - t, "0.0000")

16. End Sub

复制代码

方法二：CopyFile
需调用FileSystemObject，多个文件可使用通配符。
语法：

object.CopyFile source, destination[, overwrite]

**CopyFile **方法语法有如下几部分：

| 部分 | 描述 |
| object | 必需的。object始终是一个 **FileSystemObject 的名字。 |
| source | 必需的。指明一个或多个要被复制文件的字符串文件说明，它可以包括通配符。 |
| destination | 必需的。指明 source 中的一个或多个文件要被复制到的接受端的字符串，不允许有通配符。 |
| overwrite | 选项的。Boolean 值，它表示存在的文件是否被覆盖。如果是 True，文件将被覆盖；如果是 False，它们不被覆盖。缺省值是 True。注意如果 destination 具有只读属性设置，不论 overwrite 值如何，CopyFile **都将失败。 |

代码：

1. Sub 复制当前路径的所有文件到指定文件夹_CopyFile()

2. t = Timer

3. Dim Fso As Object

4. Dim 当前路径 As String, 目标路径 As String

5. 当前路径 = ThisWorkbook.Path & "*." '如果只复制xls则把 "." 改成 ".xls"

6. 目标路径 = "C:\汇总数据" '目标路径

7. Set Fso = CreateObject("Scripting.FileSystemObject")

8. Fso.CopyFile 当前路径, 目标路径

9. Set Fso = Nothing

10. MsgBox Format(Timer - t, "0.0000")

11. End Sub

复制代码 方法三：XCopy
批处理，shell调用
**文中用了 ****shell ****Environ("ComSpec") **
其中：Environ("ComSpec") 可以获得下列文字"c:\windows\system32\cmd.exe"
语法：
XCOPY source [destination]

| source | 指定要复制的文件。 |
| destination | 指定新文件的位置和/或名称。 |

指定要复制文件也可带通配符。还包含很多参数。XCOPY是COPY的扩展，可以把指定的目录连文件和目录结构一并拷贝，但不能拷贝系统文件。
代码：

1. Sub 复制当前路径的所有文件到指定文件夹_XCOPY()

2. t = Timer

3. Dim 当前路径 As String, 目标路径 As String

4. 当前路径 = ThisWorkbook.Path & "*." '如果只复制xls则把 "." 改成 ".xls"

5. 目标路径 = "C:\汇总数据" '目标路径

6. Shell Environ("comspec") & " /c xcopy " & 当前路径 & " " & 目标路径, vbHide

7. MsgBox Format(Timer - t, "0.0000")

8. End Sub

复制代码

三种方法速度对比
附件中有文件101个，每个约20K左右
FileCopy：约0.3秒
CopyFile：约0.06秒
XCopy: 约0.007秒

使用批处理，超快。
附件：
<ignore_js_op style="word-wrap: break-word; color: rgb(68, 68, 68); font-family: Tahoma, Deng; font-size: 14px; font-style: normal; font-variant: normal; font-weight: normal; letter-spacing: normal; line-height: normal; orphans: auto; text-align: start; text-indent: 0px; text-transform: none; white-space: normal; widows: 1; word-spacing: 0px; -webkit-text-stroke-width: 0px; background-color: rgb(255, 255, 255);">

image

复制当前路径的所有文件到指定文件夹_芐雨.zip (1.36 MB, 下载次数: 318)</ignore_js_op>