Each day, a batch job pulls data that is used to generate metrics for a report. The data is stored in a table-like structure in an Excel spreadsheet, where it is used to generate the reporting metrics within the same workbook. Typically, the file name is the date of the prior operating day in the format “MM.DD.YY”. The files are saved in a folder indicating the month and year of that date–for example, “12-2013”–which is itself a subfolder of the given year–“2013”.
For a project, I needed several weeks worth of raw data. One option was to write a query for the main database and then import the output file into a program of my choosing. But for reasons I won’t get into, this is easier said than done. So, I decided to write a script that would generate a list of the file paths that I would import into a single CSV file. Python would be my first choice for this task, but it is not available on my work computer. So, I turned to VBA–my only choice, really.
Before you start, make sure your project has a reference set to the Microsoft Scripting Runtime library. In the code below, I have assumed that we are only interested in aggregating the data from one year (e.g. 2013), so the loop through the year folders has been eliminated.
Sub ImportFiles() Dim fso As FileSystemObject Dim fldr As Folder, subfldr As Folder Dim fl As File Dim wbk_Main As Workbook, wbk As Workbook Dim wsht_Main As Worksheet, wsht As Worksheet Set wbk_Main = ThisWorkbook Set wsht_Main = ThisWorkbook.Worksheets("Sheet1") Dim rng As Range Dim strFile_Path As String strFile_Path = "[PATH]" ' Create index counter for total number of rows copied Dim i As Integer ' Create index counter for number of rows to be copied from given file Dim k As Integer i = 0 k = 0 ' Create the file system object Set fso = CreateObject("Scripting.FileSystemObject") ' Get the root folder Set fldr = fso.GetFolder(strFile_Path) ' Loop through the subfolders For Each subfldr In fldr.SubFolders ' Loop through the files For Each fl In subfldr.Files ' Open the workbook Set wbk = Workbooks.Open(fl.Path) Set wsht = wbk.Worksheets("Data") ' Count the number of rows to import k = wsht.Range("A1").End(xlDown).Row ' Only import the headers once If i = 0 Then Set rng = wsht.Range("A1", "C" & k) wsht_Main.Range("A1", "C" & k) = rng.Value i = i + k Else Set rng = wsht.Range("A" & 2, "C" & k) wsht_Main.Range("A" & i + 1, "C" & (i + k - 1)) = rng.Value i = i + k - 1 End If ' Close the workbook wbk.Close SaveChanges:=False Next Next ' Save as CSV fle Application.DisplayAlerts = False wbk_Main.SaveAs Filename:=(strFile_Path & "Import"), FileFormat:=xlCSV Application.DisplayAlerts = True ' Clean up Set rng = Nothing Set fso = Nothing Set wbk = Nothing Set wbk_Main = Nothing End Sub