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: