Excel VBA
Excel 文件复制的3种方法
2017-01-05 15:06:52

作者: 芐雨

如何复制当前路径的所有文件到指定文件夹 方法一：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秒使用批处理，超快。

补充：

作者：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

这种方法更保险

网站首页