Last time we learnt how to use the File Object System (FSO) to copy specific Files from source Folder into Destination Folder. Today we learn how to loop through the subfolders of the source folder, find all the files in each subfolder and copy them into the destination folder with VBA quickly and easily. There are many approaches to solving this problem including creation of a customized function. But the FSO approach with a secondary macro which is called from the first macro provides an elegant solution. Watch the video below:

We can view this video also on YouTube.

Here’s the complete VBA code:
Sub copy_specific_files_in_folder()
Dim FSO As Object
Dim sourcePath As String
Dim destinationPath As String
Dim fileExtn As String

sourcePath = “C:\exceltrainingvideos”
destinationPath = “C:\Users\takyar\test100\”

fileExtn = “*.xlsx”

If Right(sourcePath, 1) <> “\” Then
sourcePath = sourcePath & “\”
End If

Set FSO = CreateObject(“scripting.filesystemobject”)

If FSO.FolderExists(sourcePath) = False Then
MsgBox sourcePath & ” does not exist”
Exit Sub
End If

If FSO.FolderExists(destinationPath) = False Then
MsgBox destinationPath & ” does not exist”
Exit Sub
End If

FSO.CopyFile Source:=sourcePath & fileExtn, Destination:=destinationPath

copy_files_from_subfolders

MsgBox “Your files have been copied from the sub-folders of ” & sourcePath & ” to ” & destinationPath

End Sub

Sub copy_files_from_subfolders()
Dim FSO As Object, fld As Object
Dim fsoFile As Object
Dim fsoFol As Object

sourcePath = “C:\exceltrainingvideos”
targetPath = “C:\Users\takyar\test100\”

If Right(sourcePath, 1) <> “\” Then sourcePath = sourcePath & “\”

Set FSO = CreateObject(“Scripting.FileSystemObject”)
Set fld = FSO.GetFolder(sourcePath)
If FSO.FolderExists(fld) Then
For Each fsoFol In FSO.GetFolder(sourcePath).SubFolders
For Each fsoFile In fsoFol.Files
If Right(fsoFile, 4) = “xlsx” Then
fsoFile.Copy targetPath
End If
Next
Next
End If

End Sub

Further reading:

Accessing Files with FileSystemObject