复制文件的更快方法

Question

我试图使用以下脚本复制文件。

Option Explicit 

Const ForWriting = 2 
Dim objFSO 
Dim desfolder 
Dim oShell 
dim s 

desfolder = "D:\Databases" 
Set objFSO = CreateObject("Scripting.FileSystemObject") 

Recurse objFSO.GetFolder("D:\Databases\Images") 

Sub Recurse(objFolder) 
    Dim objFile, objSubFolder 

    For Each objFile In objFolder.Files 
     If LCase(objFSO.GetExtensionName(objFile.Name)) = "tif" Then 
      s = Right(objFile.Name, 10) 
      S = Left(s, 1) 
      If Left(s, 1) = "C" Then 
       Set oShell = WScript.CreateObject("WScript.Shell") 
       oShell.Run "xcopy.exe " & objFile & " " & desfolder & " /R /Y", _ 
        0, True 
      End If 
     End If 
    Next 
    For Each objSubFolder In objFolder.SubFolders 
     Recurse objSubFolder 
    Next 
End Sub 

我想要做的是检查文件夹和子文件夹中的文件。如果文件是tif，然后检查天气，它包含在特定位置所需的字母“C”。并使用xcopy复制文件。

它工作正常，但速度很慢。 有没有更快的方法来做到这一点？

编辑：我想要的确实是在文件夹及其子文件夹中找到c*.tif。

Answer 1

然后请不要使用xcopy。按照您的方式，每次复制文件时都会产生一个新进程。只需使用文件对象的方法Copy并完成它。

Sub Recurse(objFolder) 
    Dim objFile, objSubFolder 

    For Each objFile In objFolder.Files 
     If LCase(objFSO.GetExtensionName(objFile)) = "tif" Then 
      If LCase(Left(objFile.Name, 1) = "c" Then 
       objFile.Copy desfolder & "\" 
      End If 
     End If 
    Next 
    For Each objSubFolder In objFolder.SubFolders 
     Recurse objSubFolder 
    Next 
End Sub 

请注意，您的目标路径需要一个尾部的反斜杠，因为它是一个文件夹（你会得到一个"permission denied" error没有它）。否则，你需要指定包括文件名的目标路径，例如像这样：

objFile.Copy objFSO.BuildPath(desfolder, objFile.Name)