Using VBA to retrieve Column Headers from Excel files - vba

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.

Answer 2

Cell in col header is limited to 255 chars only due to limitation in ADODB.