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

如何復(fù)制當(dāng)前路徑的所有文件到指定文件夾

方法一：**FileCopy **
可在VBA中直接引用，單個(gè)文件的copy。所以本例中用循環(huán)+復(fù)制完成。
語(yǔ)法：
FileCopy 源文件名,目標(biāo)文件名 【兩個(gè)參數(shù)都是必選的,且都包含路徑?！?/p>

注：如果想要對(duì)一個(gè)已打開(kāi)的文件使用 FileCopy 語(yǔ)句，則會(huì)產(chǎn)生錯(cuò)誤。所以用了 ActiveWorkbook.SaveCopyAs +完整路徑

代碼：

1. Sub 復(fù)制當(dāng)前路徑的所有文件到指定文件夾_FileCopy()

2. t = Timer

3. Dim 當(dāng)前路徑 As String, 目標(biāo)路徑 As String

4. Dim fs

5. On Error Resume Next

6. 當(dāng)前路徑 = ThisWorkbook.Path & ""

7. 目標(biāo)路徑 = "C:\匯總數(shù)據(jù)" '目標(biāo)目錄

8. fs = Dir(當(dāng)前路徑 & "") '如果只復(fù)制xls則把 "" 改成 "*.xls")

9. Do While fs <> ""

10. FileCopy 當(dāng)前路徑 & fs, 目標(biāo)路徑 & fs

11. fs = Dir

12. Loop

13. ActiveWorkbook.SaveCopyAs 目標(biāo)路徑 & ThisWorkbook.Name

14. '*******如果想要對(duì)一個(gè)已打開(kāi)的文件使用 FileCopy 語(yǔ)句，則會(huì)產(chǎn)生錯(cuò)誤******

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

16. End Sub

復(fù)制代碼

方法二：CopyFile
需調(diào)用FileSystemObject，多個(gè)文件可使用通配符。
語(yǔ)法：

object.CopyFile source, destination[, overwrite]

**CopyFile **方法語(yǔ)法有如下幾部分：

| 部分 | 描述 |
| object | 必需的。object始終是一個(gè) **FileSystemObject 的名字。 |
| source | 必需的。指明一個(gè)或多個(gè)要被復(fù)制文件的字符串文件說(shuō)明，它可以包括通配符。 |
| destination | 必需的。指明 source 中的一個(gè)或多個(gè)文件要被復(fù)制到的接受端的字符串，不允許有通配符。 |
| overwrite | 選項(xiàng)的。Boolean 值，它表示存在的文件是否被覆蓋。如果是 True，文件將被覆蓋；如果是 False，它們不被覆蓋。缺省值是 True。注意如果 destination 具有只讀屬性設(shè)置，不論 overwrite 值如何，CopyFile **都將失敗。 |

代碼：

1. Sub 復(fù)制當(dāng)前路徑的所有文件到指定文件夾_CopyFile()

2. t = Timer

3. Dim Fso As Object

4. Dim 當(dāng)前路徑 As String, 目標(biāo)路徑 As String

5. 當(dāng)前路徑 = ThisWorkbook.Path & "*." '如果只復(fù)制xls則把 "." 改成 ".xls"

6. 目標(biāo)路徑 = "C:\匯總數(shù)據(jù)" '目標(biāo)路徑

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

8. Fso.CopyFile 當(dāng)前路徑, 目標(biāo)路徑

9. Set Fso = Nothing

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

11. End Sub

復(fù)制代碼 方法三：XCopy
批處理，shell調(diào)用
**文中用了 ****shell ****Environ("ComSpec") **
其中：Environ("ComSpec") 可以獲得下列文字"c:\windows\system32\cmd.exe"
語(yǔ)法：
XCOPY source [destination]

| source | 指定要復(fù)制的文件。 |
| destination | 指定新文件的位置和/或名稱。 |

指定要復(fù)制文件也可帶通配符。還包含很多參數(shù)。XCOPY是COPY的擴(kuò)展，可以把指定的目錄連文件和目錄結(jié)構(gòu)一并拷貝，但不能拷貝系統(tǒng)文件。
代碼：

1. Sub 復(fù)制當(dāng)前路徑的所有文件到指定文件夾_XCOPY()

2. t = Timer

3. Dim 當(dāng)前路徑 As String, 目標(biāo)路徑 As String

4. 當(dāng)前路徑 = ThisWorkbook.Path & "*." '如果只復(fù)制xls則把 "." 改成 ".xls"

5. 目標(biāo)路徑 = "C:\匯總數(shù)據(jù)" '目標(biāo)路徑

6. Shell Environ("comspec") & " /c xcopy " & 當(dāng)前路徑 & " " & 目標(biāo)路徑, vbHide

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

8. End Sub

復(fù)制代碼

三種方法速度對(duì)比
附件中有文件101個(gè)，每個(gè)約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

復(fù)制當(dāng)前路徑的所有文件到指定文件夾_芐雨.zip (1.36 MB, 下載次數(shù): 318)</ignore_js_op>