The destination folder must not exist.  It will be created by the procedure. There are three functions in the code:

There are two versions of the Clone Folder code: CloneFolder and CloneFolderEx. The difference is that CloneFolderEx prompts for and accepts a procedure name that will be called automatically for each file copied from SourceFolder to DestinationFolder.  This function may change the name of the destination file. For example, you may which to append "_PREVIOUS" to each file name . The default mode is to leave the ConversionProcedure parameter a vbNullString, in which case CloneFolderEx functions identically to CloneFolder.

 CloneFolder

CloneFolder

Sub CloneFolder()

This procedure simply prompts the user for the Source and Destination folders and passes those folder names to CloneTheFolder. This step is separated into its own procedure, rather than being included in CloneTheFolder, so that you can automate the Clone operation without user input.

CloneTheFolder

Sub CloneTheFolder(SourceFolderName As String, DestFolderName As String)

This procedure sets up the Folder objects for the Source Folder and Destination Folder, and then calls CreateCopyItem to do the cloning. SourceFolderName is the name of the folder to clone, and DestFolderName is the name of the new destination folder. The procedure will create DestFolderName.   DestFolderName must not exist when you run the code.

SourceFolderName and DestFolderName may name a folder on a local drive, a mapped network drive, to a UNC folder specification.

CreateCopyItem

Private Sub CreateCopyItem(FSO As Scripting.FileSystemObject, _
    SourceFolderObj As Scripting.Folder, DestFolderObj As Scripting.Folder)

This procedure does the actual work.  In order to support folders nested to any depth, it calls itself recursively, processing one subfolder at a time.

The complete code is shown below. You can also download a module file here.

Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modCloneFolder
' By Chip Pearson, www.cpearson.com chip@cpearson.com
' This module requires a reference to the Microsoft Scripting Runtime (typically located
' at C:\WINDOWS\system32\scrrun.dll).
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub CloneFolder()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CloneFolder
' This procedure prompts the user for the source and destination folders and
' passes them to the procedure CloneTheFolder. CloneTheFolder does the
' actual work of cloning the folder.
' The user-input code takes place in this procedure rather than in the
' CloneTheFolder function in order to allow automation of the
' CloneTheFolder procedure without user input.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim SourceFolderName As String
Dim DestFolderName  As String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt user for Source Folder Name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SourceFolderName = InputBox("Enter the Full Name of the Source folder", "Clone Folder")
If Trim(SourceFolderName) = vbNullString Then
    '''''''''''''''''''''
    ' User cancelled out.
    '''''''''''''''''''''
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt user for Destination Folder Name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DestFolderName = InputBox("Enter the Full Name of the destination folder." & vbCrLf & _
    "The Destination Folder must not exist.")
If Trim(DestFolderName) = vbNullString Then
    '''''''''''''''''''''
    ' User cancelled out.
    '''''''''''''''''''''
    Exit Sub
End If

CloneTheFolder SourceFolderName:=SourceFolderName, DestFolderName:=DestFolderName


End Sub


Sub CloneTheFolder(SourceFolderName As String, DestFolderName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CloneFolder
' This makes a complete copy of one folder, including all files and subfolder
' The folder hierarchy of the Source folder is replicated in the new folder.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SourceFolderObj As Scripting.Folder
Dim DestFolderObj As Scripting.Folder
Dim FSO As Scripting.FileSystemObject

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Create an instance of the FileSystemObjectx
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FSO = New Scripting.FileSystemObject

'''''''''''''''''''''''''''''
' Ensure SourceFolder exists.
'''''''''''''''''''''''''''''
If FSO.FolderExists(SourceFolderName) = False Then
    MsgBox "Source Folder Does Not Exist", vbOKOnly, "Close Folder"
    Exit Sub
End If

    
'''''''''''''''''''''''''''''''''''''''''''
' Ensure Destination folder does NOT exist.
'''''''''''''''''''''''''''''''''''''''''''
If FSO.FolderExists(DestFolderName) = True Then
    MsgBox "The destination folder already exists.", vbOKOnly, "Clone Folder"
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''
' Create the Destination Folder
'''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
MkDir DestFolderName
If Err.Number <> 0 Then
    MsgBox "Unable To Create Destination Folder:" & vbCrLf & _
        "'" & DestFolderName & "'" & vbCrLf & _
        "Err: " & CStr(Err.Number) & " " & Err.Description
    Exit Sub
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' Set the scripting variables.
''''''''''''''''''''''''''''''''''''''''''''''
Set SourceFolderObj = FSO.GetFolder(SourceFolderName)
Set DestFolderObj = FSO.GetFolder(DestFolderName)

'''''''''''''''''''''''''''''''''''''''''''''''
' Copy the items, starting with the top-level
' folder named in SourceFolderName to
' DestFolderName. The procedure CreateCopyItem
' will call itself for subfolders within
' SourceFolderObj.
''''''''''''''''''''''''''''''''''''''''''''''''
CreateCopyItem FSO:=FSO, SourceFolderObj:=SourceFolderObj, DestFolderObj:=DestFolderObj

End Sub

Private Sub CreateCopyItem(FSO As Scripting.FileSystemObject, _
    SourceFolderObj As Scripting.Folder, DestFolderObj As Scripting.Folder)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CreateCopyItem
' This function copies all files in SourceFolderObj to DestFolderObj. It
' then calls itself to handle the SubFolders of SourceFolderObj. It will
' preserve the folder heirarachy as it exists in the SourceFolderObj
' folder.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SubFolder As Scripting.Folder
Dim OneFile As Scripting.File
Dim FileNameOnly As String
Dim CopyFileName As String
Dim DestFileName As String
Dim DestFolder As Scripting.Folder
Dim NewSubFolderObj As Scripting.Folder
Dim NewSubFolderName As String

''''''''''''''''''''''''''''''''''''''''''
' For each file, copy it from the
' source folder to the destination
' folder.
''''''''''''''''''''''''''''''''''''''''''
For Each OneFile In SourceFolderObj.Files
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' Get the file name without any Path information.
    '''''''''''''''''''''''''''''''''''''''''''''''''
    FileNameOnly = OneFile.Name
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Set CopyFileName to the FileNameOnly in SourceFolderObj.Path.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    CopyFileName = SourceFolderObj.Path & "\" & FileNameOnly
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Set DestFileName to the FileNameOnly in DestFolderObj.Path
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    DestFileName = DestFolderObj.Path & "\" & FileNameOnly
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy the file from Source Folder to Destintaion Folder.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    FileCopy Source:=CopyFileName, Destination:=DestFileName
Next OneFile

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' For each SubFolder of SourceFolderObj, create
' a subfolder of Destination Folder with the same name.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each SubFolder In SourceFolderObj.SubFolders
    NewSubFolderName = DestFolderObj.Path & "\" & SubFolder.Name
    ''''''''''''''''''''''''''
    ' Create the new directory
    ''''''''''''''''''''''''''
    MkDir NewSubFolderName
    Set NewSubFolderObj = FSO.GetFolder(NewSubFolderName)
    '''''''''''''''''''''''''''''''''''''''''''''''''''
    ' The following line of code call this same function,
    ' recursively, for the subfolders.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    CreateCopyItem FSO:=FSO, SourceFolderObj:=SubFolder, DestFolderObj:=NewSubFolderObj
    
Next SubFolder

End Sub

CloneFolderEx

CloneFolderEx

Sub CloneFolderEx()

This procedure simply prompts the user for the Source and Destination folders and the name of the Conversion Procedure and passes those names to CloneTheFolderEx. This step is separated into its own procedure, rather than being included in CloneTheFolderEx, so that you can automate the Clone operation without user input.

CloneTheFolderEx

Sub CloneTheFolderEx(SourceFolderName As String, DestFolderName As String, _
        Optional ConversionProcedure As String = vbNullString)

This procedure sets up the Folder objects for the Source Folder and Destination Folder, and then calls CreateCopyItemEx to do the cloning.  SourceFolderName is the name of the folder to clone, and DestFolderName is the name of the new destination folder, and ConversionProcedure is then name of the file name conversion procedure.

The procedure will create DestFolderName.   DestFolderName must not exist when you run the code.  SourceFolderName and DestFolderName may name a folder on a local drive, a mapped network drive, to a UNC folder specification.

CreateCopyItemEx

Private Sub CreateCopyItemEx(FSO As Scripting.FileSystemObject, _
    SourceFolderObj As Scripting.Folder, DestFolderObj As Scripting.Folder, _
    Optional ConversionProcedure As String = vbNullString)

This procedure does the actual work.  In order to support folders nested to any depth, it calls itself recursively, processing one subfolder at a time. If ConversionProcedure is not an empty string , it must name an existing VBA function that will return a string with the DestinationFileName, fully qualified with drive and folder information (e.g., "C:\Temp\Folder\FileName.ext"). If the Conversion Procedure returns an unqualified or partially qualified file name (e.g,. "Folder\Filename.ext"),  the results are unpredictable. The Conversion Procedure is called only when copying a file, not when creating a folder. The Conversion Procedure's declaration must be the following:

Public Function ConversionProcedure(ByVal FileNameOnly As String, _
        SourceFolderName As String, DestFolderName As String) As String

You may, of course, change the name of the procedure, but its parameter types and return value must be declared as shown above.

If you do not want to use a conversion procedure, use CloneFolder rather than CloneFolderEx, or in CloneFolderEx set the ConverionProcedure parameter to vbNullString.

The complete code is shown below. You can also download a module file here.

Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modCloneFolderEx
' By Chip Pearson, www.cpearson.com chip@cpearson.com
' This module requires a reference to the Microsoft Scripting Runtime (typically located
' at C:\WINDOWS\system32\scrrun.dll).
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub CloneFolderEx()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CloneFolderEx
' This procedure prompts the user for the source and destination folders and
' the name of the filename conversion procedure, if any, and passes them to the
' procedure CloneTheFolder. CloneTheFolder does the actual work of cloning the folder.
' The user-input code takes place in this procedure rather than in the
' CloneTheFolder function in order to allow automation of the CloneTheFolder
' procedure without user input.
'
' If a ConversionProcedure was specified, that procedure
' is called and it is responsible for creating the
' DestFileName. No testing is done on the result of
' ConversionProcedure. The source file will be copied to a file
' whose name is the result of ConversionProcedure. ConversionProcedure
' is called for each file being copied (files only, not folders).
' The ConversionProcedure must declared as
'
'        Function ConversionProcedure(ByVal FileNameOnly As String, _
'           ByVal SourceFolderName As String, ByVal DestFolderName As String) As String
'
' Where FileNameOnly is the name without any path information
' of the file being copied, SourceFolderName is the name of the folder
' that FileNameOnly is being copied FROM, and DestFolderName
' is the name of the folder than FileNameOnly is being copied TO.
'
' You may change the name of the ConversionProcedure to any valid procedure
' name, but it MUST be declare as shown above.
'
' This procedure should return the fully qualified name of the
' destination file, including complete path information. If
' ConversionProcedure returns a filename without path information,
' the results are unpredictable.
'
' The conversion procedure must be in the same workbook as this code.
'
' These procedures support local drives, mapped drives, and UNC specification
' locations.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim SourceFolderName As String
Dim DestFolderName  As String
Dim ConversionProcedureName As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt user for Source Folder Name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SourceFolderName = InputBox("Enter the Full Name of the Source folder", "Clone Folder")
If Trim(SourceFolderName) = vbNullString Then
    '''''''''''''''''''''
    ' User cancelled out.
    '''''''''''''''''''''
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt user for Destination Folder Name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DestFolderName = InputBox("Enter the Full Name of the destination folder." & vbCrLf & _
    "The Destination Folder must not exist.")
If Trim(DestFolderName) = vbNullString Then
    '''''''''''''''''''''
    ' User cancelled out.
    '''''''''''''''''''''
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt the user for the name of the Name Conversion
' procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ConversionProcedureName = InputBox("Enter the name of the procedure that will" & _
    " used to modify the destination file names. Click Cancel if you won't be" & _
    " converting file names.")
   

CloneTheFolderEx SourceFolderName:=SourceFolderName, DestFolderName:=DestFolderName, _
    ConversionProcedure:=ConversionProcedureName


End Sub


Sub CloneTheFolderEx(SourceFolderName As String, DestFolderName As String, _
        Optional ConversionProcedure As String = vbNullString)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CloneFolder
' This makes a complete copy of one folder, including all files and subfolder
' The folder hierarchy of the Source folder is replicated in the new folder.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SourceFolderObj As Scripting.Folder
Dim DestFolderObj As Scripting.Folder
Dim FSO As Scripting.FileSystemObject

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Create an instance of the FileSystemObjectx
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FSO = New Scripting.FileSystemObject

'''''''''''''''''''''''''''''
' Ensure SourceFolder exists.
'''''''''''''''''''''''''''''
If FSO.FolderExists(SourceFolderName) = False Then
    MsgBox "Source Folder Does Not Exist", vbOKOnly, "Close Folder"
    Exit Sub
End If

    
'''''''''''''''''''''''''''''''''''''''''''
' Ensure Destination folder does NOT exist.
'''''''''''''''''''''''''''''''''''''''''''
If FSO.FolderExists(DestFolderName) = True Then
    MsgBox "The destination folder already exists.", vbOKOnly, "Clone Folder"
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''
' Create the Destination Folder
'''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
MkDir DestFolderName
If Err.Number <> 0 Then
    MsgBox "Unable To Create Destination Folder:" & vbCrLf & _
        "'" & DestFolderName & "'" & vbCrLf & _
        "Err: " & CStr(Err.Number) & " " & Err.Description
    Exit Sub
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' Set the scripting variables.
''''''''''''''''''''''''''''''''''''''''''''''
Set SourceFolderObj = FSO.GetFolder(SourceFolderName)
Set DestFolderObj = FSO.GetFolder(DestFolderName)

'''''''''''''''''''''''''''''''''''''''''''''''
' Copy the items, starting with the top-level
' folder named in SourceFolderName to
' DestFolderName. The procedure CreateCopyItem
' will call itself for subfolders within
' SourceFolderObj.
''''''''''''''''''''''''''''''''''''''''''''''''
CreateCopyItemEx FSO:=FSO, SourceFolderObj:=SourceFolderObj, DestFolderObj:=DestFolderObj, _
        ConversionProcedure:=ConversionProcedure

End Sub

Private Sub CreateCopyItemEx(FSO As Scripting.FileSystemObject, _
    SourceFolderObj As Scripting.Folder, DestFolderObj As Scripting.Folder, _
    Optional ConversionProcedure As String = vbNullString)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CreateCopyItem
' This function copies all files in SourceFolderObj to DestFolderObj. It
' then calls itself to handle the SubFolders of SourceFolderObj. It will
' preserve the folder heirarachy as it exists in the SourceFolderObj
' folder.
'
' If a ConversionProcedure was specified, that procedure
' is called and it is responsible for creating the
' DestFileName. No testing is done on the result of
' ConversionProcedure. This procedure is declared as
'
'        Function ConversionProcedure(ByVal FileNameOnly As String, _
'           ByVal SourceFolderName As String, ByVal DestFolderName As String) As String
'
' Where FileNameOnly is the name without any path information
' of the file being copied, SourceFolderName is the name of the folder
' that FileNameOnly is being copied FROM, and DestFolderName
' is the name of the folder than FileNameOnly is being copied TO.
'
' You may change the name of the ConversionProcedure to any valid procedure
' name, but it MUST be declare as shown above.
'
' This procedure should return the fully qualified name of the
' destination file, including complete path information. If
' ConversionProcedure returns a filename without path information,
' the results are unpredictable.
'
' The conversion procedure must be in the same workbook as this code.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SubFolder As Scripting.Folder
Dim OneFile As Scripting.File
Dim FileNameOnly As String
Dim CopyFileName As String
Dim DestFileName As String
Dim DestFolder As Scripting.Folder
Dim NewSubFolderObj As Scripting.Folder
Dim NewSubFolderName As String

''''''''''''''''''''''''''''''''''''''''''
' For each file, copy it from the
' source folder to the destination
' folder.
''''''''''''''''''''''''''''''''''''''''''
For Each OneFile In SourceFolderObj.Files
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' Get the file name without any Path information.
    '''''''''''''''''''''''''''''''''''''''''''''''''
    FileNameOnly = OneFile.Name
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Set CopyFileName to the FileNameOnly in SourceFolderObj.Path.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    CopyFileName = SourceFolderObj.Path & "\" & FileNameOnly
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Set DestFileName to the FileNameOnly in DestFolderObj.Path.
    '
    ' If a ConversionProcedure was specified, that procedure
    ' is called and it is responsible for creating the
    ' DestFileName. No testing is done on the result of
    ' ConversionProcedure. This procedure is declared as
    '
    '        Function ConversionProcedure(ByVal FileNameOnly As String, _
    '           ByVal SourceFolderName As String, ByVal DestFolderName As String) As String
    '
    ' Where FileNameOnly is the name without any path information
    ' of the file being copied, SourceFolderName is the name of the folder
    ' that FileNameOnly is being copied FROM, and DestFolderName
    ' is the name of the folder than FileNameOnly is being copied TO.
    ' This procedure should return the fully qualified name of the
    ' destination file, including complete path information. If
    ' ConversionProcedure returns a filename without path information,
    ' the results are unpredictable.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Trim(ConversionProcedure) <> vbNullString Then
        DestFileName = Application.Run(ConversionProcedure, FileNameOnly, SourceFolderObj.Path, DestFolderObj.Path)
    Else
        DestFileName = DestFolderObj.Path & "\" & FileNameOnly
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy the file from Source Folder to Destintaion Folder.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    FileCopy Source:=CopyFileName, Destination:=DestFileName
Next OneFile

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' For each SubFolder of SourceFolderObj, create
' a subfolder of Destination Folder with the same name.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each SubFolder In SourceFolderObj.SubFolders
    NewSubFolderName = DestFolderObj.Path & "\" & SubFolder.Name
    ''''''''''''''''''''''''''
    ' Create the new directory
    ''''''''''''''''''''''''''
    MkDir NewSubFolderName
    Set NewSubFolderObj = FSO.GetFolder(NewSubFolderName)
    '''''''''''''''''''''''''''''''''''''''''''''''''''
    ' The following line of code call this same function,
    ' recursively, for the subfolders.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    CreateCopyItemEx FSO:=FSO, SourceFolderObj:=SubFolder, DestFolderObj:=NewSubFolderObj
    
Next SubFolder

End Sub

Public Function ConversionProcedure(ByVal FileNameOnly As String, _
        SourceFolderName As String, DestFolderName As String) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ConversionProcedure
' This is an example ConversionProcedure. It appends "_PREVIOUS" at the end of the
' filename, right before the exentsion
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim ExtPos As Integer
Dim FName As String
ExtPos = InStrRev(FileNameOnly, ".", -1)
If ExtPos Then
    FName = DestFolderName & "\" & Left(FileNameOnly, ExtPos - 1) & "_PREVIOUS" & Mid(FileNameOnly, ExtPos)
Else
    FName = DestFolderName & "\" & FileNameOnly
End If

ConversionProcedure = FName

End Function