Sub GetTables()

    Dim cat As New ADOX.Catalog
    Dim cn As New ADODB.Connection
    Dim tbl As ADOX.Table
    
    
    Set cn = New ADODB.Connection
    
    Cells.Clear
    strSourceFile = GetFileName  ' это моя функция возвращает диалог по открытию файла, 
                                            'если путь знаете то не нужна
    If strSourceFile = "" Then strSourceFile = "С:\temp.xls"
     Cells( 1 ,  3 ) = strSourceFile
    
    cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;ReadOnly=True;" & "DBQ=" & strSourceFile & ";"
  
  x =  0 
 
        Set cat.ActiveConnection = cn
        
        For Each tbl In cat.Tables
                x = x +  1 
                Cells(x,  2 ) = tbl.Type
                Cells(x,  1 ) = tbl.Name
        Next
        
        Set cat.ActiveConnection = Nothing
 
    
    cn.Close
    Set cn = Nothing
    
End Sub

Option Compare Text
 
Private Sub VBProject_References1()
Dim iPath$, iFileName$, iCount%
    iPath$ = Environ("WinDir")
    'iFileName$ = iPath$ & "\System32\Scrrun.dll" 'Microsoft Scripting Runtime
    'iFileName$ = iPath$ & "\System32\FM20.dll" 'Microsoft Forms 2.0 Object Library
    'iFileName$ = Application.Path & "\MSWORD.OLB" 'Microsort Word 11.0 Object Library
    iFileName$ = "C:\Program Files\Common Files\System\ado\MSADOX.dll"  '<--- строка подключения например АДО
    If Dir(iFileName$) <> "" Then
       With ThisWorkbook.VBProject.References
            For iCount% =  1  To .Count
                If .Item(iCount%).FullPath = iFileName$ Then
                   MsgBox "Эта библиотека уже подключена", , ""
                   Exit Sub
                End If
            Next
            .AddFromFile Filename:=iFileName$
       End With
    Else
       MsgBox "Отсутствует нужный файл", , ""
       Exit Sub
    End If
    MsgBox "Библиотека подключена!",  64 , ""
End Sub