Использование VBA для извлечения заголовков столбцов из файлов Excel

Question

Я работаю с кем-то, кто должен идентифицировать определенные переменные в файлах excel. В настоящее время у человека, с которым я работаю, есть большое количество папок и подпапок, в которых есть документы Excel. Он использует код VBA, который просматривает папку для подпапки, а затем возвращает путь, а затем создает гиперссылку на подпапку (это не входит в код VBA ниже) и просматривает все файлы excel внутри , независимо от уровня подпапок в основной папке.

Вот код:

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 

Это здорово, но я знаю, что должен быть лучший способ. Как я могу манипулировать этим кодом, чтобы возвращать HEADERS COLUMN любых файлов Excel, найденных A) внутри папки или B) внутри подпапки, содержащейся в папке. Я хочу, чтобы они были возвращены в таблицу Excel, чтобы 100 из Excel документов не нужно было открывать, а скорее именно этот, а затем мы можем идентифицировать любые таблицы Excel, которые нуждаются в дальнейшем расследовании, и игнорировать остальные.

Answer 1

Вы можете запросить их с помощью ADO (настроить строку подключения в случае необходимости):

'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 

Затем вызовите его, как это для каждого файла, который вы найдете:

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 

Обратите внимание, что это предполагает, что вы не знаю названия листов и должен получить заголовки для все из них. Строки в выходном массиве будут иметь вид Sheet$Field, но это можно настроить в соответствии с потребностями.