fastest way to copy files/folders vba

Question

I've written a recursive script with a couple of if statements to append all files/folders in in vba using FSO but it takes forever, and I'm looking for other methodologies, or faster ways to append files. Is using the DIR or Call shell a faster way? Any reasoning would be appreciated.

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

This turned out to be trickier than I thought and this may not be a complete solution, but you can give it a try and see if it works for you. I think part of the problem was creating the file system object every time you called the function. I moved the fso to the module level so the same one is used over and over again. That means you can't recurse while you're in the middle of iterating the subfolders, so instead I use fso to create a collection of subfolder paths and names. The error handling is focused on a single error in a single block of code.

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