人气 4484

Excel 文件复制的3种方法 [复制链接]

时时钟无艳 2017-1-5 15:06:52
作者: 芐雨
如何复制当前路径的所有文件到指定文件夹
方法一:FileCopy
可在VBA中直接引用,单个文件的copy。所以本例中用循环+复制完成。
语法:
FileCopy源文件名,目标文件名   【两个参数都是必选的,且都包含路径。】
注:如果想要对一个已打开的文件使用 FileCopy 语句,则会产生错误。所以用了 ActiveWorkbook.SaveCopyAs +完整路径
代码:
  • 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[/ol]复制代码
    方法二:CopyFile
    需调用FileSystemObject,多个文件可使用通配符。
    语法:
    object.CopyFile source, destination[, overwrite]CopyFile 方法语法有如下几部分:
    部分描述
    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

  • [/ol]复制代码
    方法三:XCopy
    批处理,shell调用
    文中用了 shellEnviron("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

  • [/ol]复制代码
    三种方法速度对比
    附件中有文件101个,每个约20K左右
    FileCopy:约0.3秒
    CopyFile:约0.06秒
    XCopy: 约0.007秒
    使用批处理,超快。
    [color=]补充:
    [color=]作者:tmtony
    如果文件正在使用中,使用以上方法复制可能会提示 拒绝 70的错误,这个时间要使用API来复制更好
    Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As LongCopyFile 源文件, 目标文件, 0

    这种方法更保险
  • 您需要登录后才可以回帖 登录 | 立即注册

    QQ|手机版|精益人 ( 沪ICP备19004111号-1 )

    GMT+8, 2024-6-4 20:39 , Processed in 0.232417 second(s), 19 queries .

    Powered by Lean.ren X3.5 Licensed  © 2001-2030 LEAN.REN