使用VBA从Excel文件中检索列标题

Duk*_*uke 1 excel vba excel-vba

我正在与必须识别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
Run Code Online (Sandbox Code Playgroud)

很好,但是我知道必须有更好的方法。我如何处理此代码以返回在文件夹A内的子文件夹或文件夹B内的B)中找到的所有excel文件的COLUMN HEADERS。我希望将它们返回到excel电子表格,这样就不需要打开100多个excel文档,而只需要打开一个,然后我们就可以确定需要进一步调查的所有excel电子表格,而忽略其余的电子表格。

Com*_*ern 5

您可以使用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
Run Code Online (Sandbox Code Playgroud)

然后对找到的每个文件这样称呼它:

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
Run Code Online (Sandbox Code Playgroud)

请注意,这假设您不知道工作表名称,而需要获取所有工作表的标题。输出数组中的字符串将采用的形式Sheet$Field,但可以根据需要进行调整。