复制文件/文件夹的最快方法vba

Question

我已经编写了一个带有几个 if 语句的递归脚本，以使用 FSO 将所有文件/文件夹附加到 vba 中，但这需要很长时间，我正在寻找其他方法或更快的附加文件的方法。使用 DIR 或 Call shell 是否更快？任何推理将不胜感激。

Option Explicit

Sub BackUpEverything()

Dim Sourcefolder As String
Const DestinationFolder As String = "C:\Users\Person1\FolderX"


Dim i As Long
Dim copyfolders(3) As String
copyfolders(0) = "C:\Users\FolderA"
copyfolders(1) = "C:\Users\FolderB"
copyfolders(2) = "C:\Users\FolderC"
copyfolders(3) = "C:\Users\FolderD"


For i = 0 To 3

Sourcefolder = copyfolders(i)
backupfiles Sourcefolder, DestinationFolder

Next i

Mgsbox "Done"

End Sub
Sub backupfiles(Sourcefolder As String, DestinationFolder As String)


Dim FSO As filesystemobject
Dim oFile As File
Dim oFolder As Folder

Set FSO = New filesystemobject

If Not FSO.folderexists(DestinationFolder) Then FSO.Createfolder DestinationFolder
On Error Resume Next
For Each oFile In FSO.Getfolder(Sourcefolder).Files

If FSO.getextensionname(oFile.Path) <> "pdf" Then

FSO.copyfile oFile.Path, DestinationFolder & " \ " & oFile.Name

Else


End If

Next oFile

On Error Resume Next

For Each oFolder In FSO.Getfolder(Sourcefolder).SUbfolders

backupfiles oFolder.Path, DestinationFolder & " \ " & oFolder.Name

Next oFolder


End Sub

Answer 1

事实证明这比我想象的要棘手，这可能不是一个完整的解决方案，但您可以尝试一下，看看它是否适合您。我认为问题的一部分是每次调用函数时都会创建文件系统对象。我将 fso 移到了模块级别，因此一遍又一遍地使用同一个。这意味着在迭代子文件夹的过程中不能递归，因此我使用 fso 创建子文件夹路径和名称的集合。错误处理主要针对单个代码块中的单个错误。

Option Explicit
    
Private fso As New FileSystemObject

Sub backupFiles(ByVal sourceFolder As String, ByVal destinationFolder As String)

    Dim oFile As File
    Dim oFolder As Folder
    Dim subfolders As Collection
    Dim var As Variant
    
    ' Create destination folder if it does not already exist.
    If Not fso.FolderExists(destinationFolder) Then fso.CreateFolder destinationFolder

    '** COPY FILES IN THIS FOLDER
    
    ' Set custom error handler.
    On Error GoTo GetFolder_Error
    
    ' Copy everything except pdf files.
    For Each oFile In fso.GetFolder(sourceFolder).Files
        If fso.GetExtensionName(oFile.Path) <> "pdf" Then
            fso.CopyFile oFile.Path, fso.BuildPath(destinationFolder, oFile.Name)
        End If
    Next oFile
    
    ' Resume default error handling.
    On Error GoTo 0

    '** BACK UP SUBFOLDERS

    Set subfolders = New Collection
    
    ' Set custom error handler.
    On Error GoTo GetFolder_Error
    
    ' Add all subfolders paths and names to collection.
    For Each oFolder In fso.GetFolder(sourceFolder).subfolders
        subfolders.Add Array(oFolder.Path, oFolder.Name)
    Next oFolder
    
    ' Resume default error handling.
    On Error GoTo 0
    
    ' Iterate collection.
    For Each var In subfolders
        backup var(0), fso.BuildPath(destinationFolder, var(1))
    Next var
    
Exit_Sub:
    Exit Sub
    
GetFolder_Error:
    ' If permission denied, print message and exit sub.
    If Err.Description = "Permission denied" Then
        Debug.Print Err.Description
        Resume Exit_Sub
    Else
        ' Default VBA error handler.
        Err.Raise Err.Number
    End If

End Sub