ADOX. Odczyt nazw tabel w bazie danych.   strona główna:
A po co ten Excel ;-)
 
    Posługując się ADO do pracy na bazach danych (czy nawet na plikach xls) nieraz przydaje się informacja czy w danym pliku znajduje  
 się tabela o danej nazwie.  
 
Jednym ze sposobów odczytu nazw tabel jest wykorzystanie obiektów ADOX.  
 
Const adStateOpen = 1  
 
Function Tables_ADOX(objConnection As Object) As Variant  
    On Error GoTo Tables_ADOX_Error  
 
    Dim objADOXCatalog As Object    'ADOX.Catalog  
    Dim objADOXTable As Object    'ADOX.Table  
    Dim tblNames() As String, i As Long  
 
    Set objADOXCatalog = CreateObject("ADOX.Catalog")  
    With objADOXCatalog  
        .ActiveConnection = objConnection  
          
        ReDim tblNames(1 To .Tables.Count)  
        For Each objADOXTable In .Tables  
            i = i + 1  
            tblNames(i) = objADOXTable.Name  
        Next  
          
    End With  
    Tables_ADOX = tblNames  
 
Tables_ADOX_Exit:  
    On Error Resume Next  
    CloseConObject objADOXCatalog.ActiveConnection  
    Set objADOXCatalog = Nothing  
    Set objADOXTable = Nothing  
    Exit Function  
 
Tables_ADOX_Error:  
    MsgBox "Byk Nr - " & Err.Number & vbCrLf & vbCrLf & _  
           Err.Description, vbExclamation, "VBAProject - Tables_ADOX"  
    Resume Tables_ADOX_Exit  
End Function  
 
Public Sub CloseConObject(Cnn As Object)  
    If Not (Cnn Is Nothing) Then  
        If Cnn.State = adStateOpen Then Cnn.Close  
        Set Cnn = Nothing  
    End If  
End Sub  
 
Jak widzimy funkcja jest napisana tak żeby działać na istniejącym już połączeniu. Czemu tak? Bo bez sensu nawiązywać połączenie  
najpierw do sprawdzenia czy tabela istnieje, połączenie zerwać i nawiązać ponownie żeby coś wykonać.  
Zatem procedura wykorzystująca tę funkcję musi nawiązać połączenie, przekazać połączenie do funkcji która zwróci tablicę   
z nazwami tabel. :-)  
    Przykład takiej procedury odczytującej nazwy tabel w pliku mdb:  
 
Sub TestMdb()  
    On Error GoTo Test_Error  
        
    Dim objConnection As Object    'ADODB.Connection  
    Dim tbl As Variant, i As Integer  
    Dim dazaMDB As String: dazaMDB = ThisWorkbook.Path & "\test.mdb"  
   
    Set objConnection = CreateObject("ADODB.Connection")  
 
    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _  
                       "Data Source=" & dazaMDB & ";"  
        
    tbl = Tables_ADOX(objConnection)  
        
    For i = LBound(tbl) To UBound(tbl)  
        If Not tbl(i) Like "MSys*" Then  
            Debug.Print tbl(i)  
        End If  
    Next  
        
Test_Exit:  
    On Error Resume Next  
    CloseConObject objConnection  
    Exit Sub  
        
Test_Error:  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - Tes"  
    Resume Test_Exit  
End Sub  
 
Mało tego :-) Ta samą procedurą możemy odczytać nazwy Arkuszy w plikach xls (lub nowszych) Wystarczy zmienić ConnecionsString  
połączenia i postawić inny warunek na zwracane nazwy "tabel"  
 
 
Sub Test()  
    On Error GoTo Test_Error  
 
    Dim objConnection As Object    'ADODB.Connection  
    Dim tbl As Variant, i As Integer  
 
    Const strXLSFileName As String = "C:\Documents and Settings\tkuchta\Pulpit\Zeszyt2.xls"  
 
    Set objConnection = CreateObject("ADODB.Connection")   Funkcja XLSConnectionString
    objConnection.Open XLSConnectionString(strXLSFileName)  
 
    tbl = Tables_ADOX(objConnection)  
 
    For i = LBound(tbl) To UBound(tbl)  
        If tbl(i) Like "*$" Or tbl(i) Like "*$'" Then  
            Debug.Print Replace(tbl(i), "'", "")  
        End If  
    Next  
 
Test_Exit:  
    On Error Resume Next  
    CloseConObject objConnection  
    Exit Sub  
 
Test_Error:  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
           Err.Description, vbExclamation, "VBAProject - Tes"  
    Resume Test_Exit  
End Sub