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.
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.
Private Sub CommandButton2_Click() CopyFilesAndFolders End Sub
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
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. ☺