Excel VBA – Create Folder and Sub Folders in another Folder and Copy Source Files to the Sub Folders

I have previously written an article along with a VBA code on how to copy or move files from one folder to another. I have explained about File System Object methods in VBA and its usefulness in transferring files. Now, I’ll show you with a simple example on how to copy files from a folder and sub folders to the destination. Since the destination folder may not have the sub folders, I’ll show how to create sub folders based on the folder name from the source to the destination.

Copy Files from Folder, Sub Folders and Create Folders in VBA

For example, the source may look like this.

“C:\books\copy1\copy3” and “C:\books\copy2”

Each folder (inside the source) may have any number of files in it. Before copying the files to the destination, the VBA code will check if 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 here however, will transfer all the files from its respective folder and sub folders, to its destination.

The VBA Code

I have added a Button (an Active Control) on my Excel workbook. The click event of the button will call a method in the Module, which has the procedure that will copy the files and create the sub folders.

Code in “Sheet1”
Private Sub CommandButton2_Click()
    CopyFilesAndFolders
End Sub
Code in “Module1”
Option Explicit

Dim sSourcePath As String
Dim sDestinationPath As String

Sub CopyFilesAndFolders()
    
    ' THE SOURCE AND DESTINATION 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 in the source along with the files in the destination.

Copy Files when Workbook Opens

Many users would opt for a procedure that will run the code immediately when they open the Excel file. For this, you need to call the above method in the Module like 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

That’s it. Hope you find the examples useful. Thanks for reading.

← PreviousNext →



Like this Article? Subscribe now, and get all the latest articles and tips, right in your inbox.

Enter your email id

Delivered by FeedBurner
Tweet this article Google+

Related Posts: