August 27, 2017

Copy Specific Files from Folder and Subfolders into Destination Folder

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


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
End If

End Sub

Further reading:

Accessing Files with FileSystemObject

One thought on “Copy Specific Files from Folder and Subfolders into Destination Folder

  1. Hi

    Im using this:

    Sub movefiles()
    ‘Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox(“Please select the file names:”, “KuTools For Excel”, ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = ” Please select the original folder:”
    If xSFileDlg.Show -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & “\”
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = ” Please select the destination folder:”
    If xDFileDlg.Show -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & “\”
    For Each xCell In xRg
    xVal = xCell.Value
    If TypeName(xVal) = “String” And xVal “” Then
    FileCopy xSPathStr & xVal, xDPathStr & xVal
    Kill xSPathStr & xVal
    End If
    End Sub

    But, i canĀ“t get to to look in subfolders ?
    Maybe you can help?

Comments are closed.