Merging Multiple Workbooks Together by Searching Directories and Sub-Folders

 
At some point in time most programmers are faced with a task where they need to recursively search through filesystem folders and perform some sort of operation on matched files.  For VBA programmers in Excel, this “operation” often involves the merging of matched .xls and .xlsx files together into a single Workbook.

Step 1 – The recursive function

Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
                    ByRef matchedFiles As Collection, ByRef objFSO As Object)

    Dim objFolder As Object
    Dim objFile As Object
    Dim objSubFolders As Object

    'Get the folder object associated with the target directory
    Set objFolder = objFSO.GetFolder(targetFolder)

    'Loop through the files current folder
    For Each objFile In objFolder.Files
        If objRegExp.test(objFile) Then
            matchedFiles.Add (objFile)
        End If
    Next

    'Loop through the each of the sub folders recursively
    Set objSubFolders = objFolder.Subfolders
    For Each objSubfolder In objSubFolders
        RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
    Next

    'Garbage Collection
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objSubFolders = Nothing

End Sub

 

Step 2 – Recursive controller

Function FindPatternMatchedFiles(sPath As String) As Collection

    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Pattern = ".*\.(xls|xlsx)"
    objRegExp.IgnoreCase = True

    Dim colFiles As Collection
    Set colFiles = New Collection

    RecursiveFileSearch sPath, objRegExp, colFiles, objFSO

    'Garbage Collection
    Set objFSO = Nothing
    Set objRegExp = Nothing

    Set FindPatternMatchedFiles = colFiles

End Function

 

Step 3 – Merge together each of the matched Workbooks

Sub MergeWorkbooks(sPath As String, sWbName As String)

    Dim colFiles As Collection
    Set colFiles = FindPatternMatchedFiles(sPath)

    Dim appExcel As New Excel.Application
    appExcel.Visible = False

    Dim wbDest As Excel.Workbook
    Set wbDest = appExcel.Workbooks.Add()

    Dim wbToAdd As Excel.Workbook
    Dim sheet As Worksheet

    For Each file In colFiles

        Set wbToAdd = appExcel.Workbooks.Open(file)

        For Each sheet In wbToAdd.Sheets
            sheet.Copy Before:=wbDest.Sheets(wbDest.Sheets.Count)
        Next sheet

        wbToAdd.Close SaveChanges:=False

    Next

    wbDest.Close True, sPath + "\" + sWbName
    Set wbDest = Nothing
    Set appExcel = Nothing

End Sub

 

Step 4 – Call the Merge Workbooks sub routine

Sub Main()

    MergeWorkbooks "C:\Path\To\Folder", "Awesomeness.xlsx"

End Sub

 

Related Articles:

• Recursive Directory Regex File Search