Using VBA to retrieve Column Headers from Excel fi

Question

I'm working with someone who has to identify certain variables within excel files. Currently, the man I'm working with has a great deal of folders and sub-folders that have Excel documents in them. He's using a VBA code that looks within a folder for a sub-folder, and then returns the pathway, then creating a hyperlink to the sub-folder (this isn't part of the VBA code below) and looking at all excel files within, no matter the level of sub-folders within the main folder.

Here's the code:

    Sub GetFolders()
Dim path As String
Dim folder As String
Dim row As Integer


path = "your directory here"
folder = Dir(path, vbDirectory)
row = 1

Do While folder <> ""
If (GetAttr(path & folder) And vbDirectory) = vbDirectory Then
    Cells(row, 1) = path & folder
    row = row + 1
End If
folder = Dir()
Loop

End Sub

This is great, but I know there has to be a better way. How can I manipulate this code to return COLUMN HEADERS of any excel files found A) within a folder or B) within a subfolder contained within a folder. I want these to be returned to an excel spreadsheet so that 100's of excel documents don't need to be opened, but rather just this one, and then we can identify any excel spreadsheets that need further investigation and ignore the rest.

Answer 1

You can query them with ADO (adjust the connection string as needed):

'Requires reference to Microsoft ActiveX Data Objects #.# Library
Private Function GetHeaders(filepath As String) As String()
    Dim output() As String
    Dim ado As New ADODB.Connection
    output = Split(vbNullString)

    With ado
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & filepath & "';" & _
              "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1;"";"
        With .OpenSchema(adSchemaTables)
            Dim table As String
            Dim columns As ADODB.Recordset
            Do While Not .EOF
                table = .Fields("TABLE_NAME")
                Set columns = ado.OpenSchema(adSchemaColumns, Array(Empty, Empty, table))
                With columns
                    Do While Not .EOF
                        ReDim Preserve output(UBound(output) + 1)
                        output(UBound(output)) = table & .Fields("COLUMN_NAME")
                        .MoveNext
                    Loop
                End With
                .MoveNext
            Loop
        End With
    End With
    GetHeaders = output
End Function

Then call it like this for each file that you find:

Sub Example()
    Dim headers() As String
    Dim i As Long
    headers = GetHeaders("C:\Foo\Bar.xlsx")
    For i = LBound(headers) To UBound(headers)
        Debug.Print headers(i)
    Next i
End Sub

Note that this assumes you don't know the sheet names and need to get headers for all of them. The strings in the output array will be in the form of Sheet$Field, but that can be adjusted according to need.