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

问题描述

我编写了一个递归脚本，其中包含几个 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

解决方法

事实证明这比我想象的要棘手，这可能不是一个完整的解决方案，但您可以尝试一下，看看它是否适合您。我认为部分问题在于每次调用该函数时都会创建文件系统对象。我将 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),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

copy directory directory fso