Access: VBA script voor overzicht van tabellen en kolommen van een database naar Excel bestand

Op de SQL Server kun je met een vrij simpele SQL query een overzicht maken van tabellen, kolommen en informatie als datatype etc.





SELECT T.table_name,column_name, data_type, T.TABLE_TYPE, character_maximum_length, ordinal_position, is_nullable
FROM INFORMATION_SCHEMA.TABLES T
INNER JOIN INFORMATION_SCHEMA.COLUMNS C ON T.TABLE_NAME=C.TABLE_NAME
WHERE T.TABLE_TYPE='BASE TABLE'  OR T.TABLE_TYPE='VIEW'
ORDER BY T.table_name,ordinal_position,column_name

De uitkomst kun je dan bijvoorbeeld kopiëren naar een Excel bestand waar je dan simpel selecties kunt doen.

In Access bestaat zoiets niet. Wil je daar een overzicht hebben van tabellen en kolommen dan kun je een rapport uitdraaien. Dat levert evenwel geen mooie lijst op. Dan komt VBA in beeld. Na enig speurwerk op internet en de nodige aanpassingen en toevoegingen door mij kom ik tot het volgende script:

Sub ListTablesADOX()
    Dim Conn As New ADODB.Connection
    Dim strConn  As String
    
    'Open connection you want To get database objects
    strConn = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=D:\data\accessontwikkeling\noordenwindb.mdb"

    'Conn.Open strConn 'access
  
    Dim objApp As Object
    Dim exlExcel As Object
    Dim lngRij As Long
    Set objApp = CreateObject("Excel.Application")
    Set exlExcel = objApp.workbooks.Add
  
    With exlExcel.sheets(1)
        .Range("A1").Offset(0, 0) = "Tabelnaam"
        .Range("A1").Offset(0, 1) = "Tabeltype"
        .Range("A1").Offset(0, 2) = "Veldnaam"
        .Range("A1").Offset(0, 3) = "Typeomschrijving"
        .Range("A1").Offset(0, 4) = "Typenummer"
        .Range("A1").Offset(0, 5) = "Attribuutomschrijving"
        .Range("A1").Offset(0, 6) = "Attribuutnummer"
        .Range("A1").Offset(0, 7) = "Grootte"
        '.Range("A1").Offset(0, 6) = "Beschrijving"
        '.Range("A1").Offset(0, 7) = "Aantal records"
        '.Range("A1").Offset(0, 8) = "Primary key"
    End With
  
    'Create catalog object
    Dim Catalog As New ADOX.Catalog
    Set Catalog.ActiveConnection = Conn
    
    'List tables And columns
    Dim Table As ADOX.Table, Column As ADOX.Column
    For Each Table In Catalog.Tables
        If Table.Type <> "SYSTEM TABLE" Then 'Access
            With exlExcel.sheets(1)
                For Each Column In Table.Columns
                    lngRij = lngRij + 1
                    .Range("A1").Offset(lngRij, 0) = Table.Name
                    .Range("A1").Offset(lngRij, 1) = Table.Type
                    .Range("A1").Offset(lngRij, 2) = Column.Name
                    .Range("A1").Offset(lngRij, 3) = VeldtypeOmschrX(Column.Type) 'access
                    .Range("A1").Offset(lngRij, 4) = Column.Type
                    .Range("A1").Offset(lngRij, 5) = VeldBeschrijvingX(Column.Attributes)
                    .Range("A1").Offset(lngRij, 6) = Column.Attributes
                    .Range("A1").Offset(lngRij, 7) = Column.DefinedSize
                Next
            End With
        End If
    Next

    objApp.Visible = True
    Set objApp = Nothing
    Set exlExcel = Nothing

    Conn.Close
    Set Conn = Nothing

End Sub

In het script verwijs ik nog naar twee zelfgemaakte functies:

Function VeldtypeOmschrX(veldtype As Long) As String
    Select Case veldtype
        Case 2
            VeldtypeOmschrX = "numeriek, geheel getal"
        Case 3
            VeldtypeOmschrX = "numeriek, lange integer"
        Case 4
            VeldtypeOmschrX = "numeriek, enkele precisie"
        Case 5
            VeldtypeOmschrX = "numeriek, dubbele precisie"
        Case 11
            VeldtypeOmschrX = "ja/nee"
        Case 16
            VeldtypeOmschrX = "numeriek byte"
        Case 72
            VeldtypeOmschrX = "numeriek, replicaId"
        Case 131
            VeldtypeOmschrX = "numeriek, decimaal"
        Case 135
            VeldtypeOmschrX = "datum/tijd"
        Case 202
            VeldtypeOmschrX = "korte tekst"
        Case 203
            VeldtypeOmschrX = "lange tekst"
        Case 205
            VeldtypeOmschrX = "OLE object"
    End Select

End Function

en nummer 2:

Function VeldBeschrijvingX(lngAttribuut As Long) As String
    Select Case lngAttribuut
        Case 0
            VeldBeschrijvingX = "tekst, not null"
        Case 1
            VeldBeschrijvingX = "numeriek of tekst(1), not null"
        Case 2
            VeldBeschrijvingX = "tekst, null"
        Case 3
            VeldBeschrijvingX = "numeriek of tekst(1),null"
    End Select

End Function

Het script levert in Excel voor de database Noordenwind de volgende tabel op: