Create folders and subfolders and copy files in subfolder using VBA

Last updated: 13th November 2022

In-addition, I’ll show how to create sub folders based on the folder name from the source to the destination.

Let us assume, I have a folder named "books" in the C:\ drive (this is the source drive). The "books" folder has two more sub-folders namely copy1 and copy2. Sub-folder "copy1" has another sub-folder named "copy3". And each folder has different files (any type of file).

The source may look like this (the source folder structure).

"C:\books\copy1\copy3" (subfolder copy1 and copy3 have different type of files)
and
"C:\books\copy2" (subfolder copy2 also have files)

Each folder (inside the source) may have n number of files in it. Before copying the files to the destination, the macro will check weather the sub-folders already exist inside the destination folder. If not, it will create the sub-folders.

I am not defining any file type with any extensions, as I did before in my previous article. The code however, will transfer all the files from its respective folder and sub-folders, to its destination.

Write the below code in a Module. So you can call the procedure from anywhere you want.

Option Explicit

Dim sSourcePath As String
Dim sDestinationPath As String

Sub copyFilesAndFolders()
    
    ' The source and desitation folder.
    sSourcePath = "C:\books\"
    sDestinationPath = "E:\booksforclient\"
    
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Dim objFolder, objSubFolder, objFile
    Dim collBooks As Collection
    
    Set collBooks = New Collection
    collBooks.Add objFSO.GetFolder(sSourcePath)
    
    Do While collBooks.Count > 0
        Set objFolder = collBooks(1)
        
        If Trim(collBooks(1)) & "\" <> sSourcePath Then
            ' Re-assign destination.
            sDestinationPath = "E:\booksforclient\"
            sDestinationPath = Replace(objFolder, sSourcePath, sDestinationPath) & "\"
        End If
        
        collBooks.Remove 1
        
        ' FIRST COPY FILES FROM THE SOURCE FOLDER TO THE DESTINATION.
        For Each objFile In objFolder.Files
            objFSO.CopyFile Source:=objFile, Destination:=sDestinationPath
        Next objFile
        
        ' NOW ADD SUB FOLDERS (IF ANY IN THE COLLECTION).
        For Each objSubFolder In objFolder.SubFolders
            collBooks.Add objSubFolder              ' ADD SUB FOLDERS IN THE COLLECTION OBJECT.
            
            ' Create sub-folders inside the destination folder.
            If Not objFSO.FolderExists(sDestinationPath & "\" & Replace(objSubFolder, sSourcePath, "")) Then
                objFSO.CreateFolder sDestinationPath & "\" & Replace(objSubFolder.Name, sSourcePath, "")
            End If
        Next objSubFolder
    Loop
End Sub

You will now have a similar folder structure along with the files at the destination.

I have hardcoded the source and destination folders. You can select folder and pass the names of the folders to the procedure or function as argument.

Copy Files when Workbook Opens

Like I said, you can call the procedure "copyFilesAndFolders()" from anywhere you want, since we have definded the procedure in a Module. So, if you want to copy folders and files when you open the file, then you should do this.

In your VBA project, open the Project Explorer window (Press Ctrl+R) and find ThisWorkBook under Microsoft Excel Objects. Write the below code in Workbook_Open() event.

Private Sub Workbook_Open()
    copyFilesAndFolders
End Sub

← PreviousNext →