Aggregating Excel Spreadsheets into a CSV with VBA

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

    ' 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

This entry was posted in Progamming, VBA and tagged , , , . Bookmark the permalink.

One Response to Aggregating Excel Spreadsheets into a CSV with VBA

  1. This is very interesting, You’re a very skilled blogger. I have joined your rss feed and sit up for looking for extra of your magnificent post. Additionally, I’ve shared your web site in my social networks!

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s