When managing projects I use a few different off-the-shelf products.  But, it always seems there is some task I need to do that can’t be done efficiently with these tools so I make sure to include MS Excel (Office 365) in my suite of project management utilities.  VBA macros within Excel give me the power to complete any custom tasks I require.

I needed to copy a set of folders (an entire recursive tree) to a new location.  VBA does not natively include this feature.  I searched the web for solutions but it seemed all were either out-of-date (non functional) or simply incomplete (never worked!).  So, I thought I’d share my solution built on the VBA scripting.filesystemobject. Hopefully it will help others. Here it is …

Public Sub TestCopyFiles()
    ' Call the recursive copy operation
    CopyFiles "c:\temp\a", "c:\temp\b"
End Sub

Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String, Optional ByVal basePath As String, Optional ByVal baseTarget As String)
    If basePath = "" Then basePath = strPath
    If baseTarget = "" Then baseTarget = strTarget
    Set FSO = CreateObject("scripting.filesystemobject")
    ' First loop through files in this folder
    For Each nextFile In FSO.getfolder(strPath).Files
        fullTargetPath = strTarget + "\" + nextFile.Name
        mkdir (strTarget)
        ' Copy one file
        FileInFromFolder.Copy fullTargetPath
    Next
    ' Next loop through folders in this folder
    For Each nextFolder In FSO.getfolder(strPath).SubFolders
        nextStrTarget = baseTarget + Right(nextFolder, Len(nextFolder) - Len(basePath))
        mkdir (nextStrTarget)
        CopyFiles nextFolder.Path, nextStrTarget, basePath, baseTarget
    Next
End Sub

Private Sub mkdir(folder As String)
    ' Create a folder if it doesn't exist
    Set FSO = CreateObject("scripting.filesystemobject")
    On Error Resume Next
    FSO.CreateFolder (folder)
    On Error GoTo 0
End Sub