Doorgaan naar hoofdcontent

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:


Reacties

Populaire posts van deze blog

Excel: VBA script om wachtwoord te verwijderen

Af en toe krijg ik een vraag om een wachtwoord van een Excel blad te halen. Doodsimpel met VBA. Hier een script dat ik gebruik:

Sub WachtwoordCrack()
    Dim a As Integer, b As Integer, c As Integer, d As Integer, _
    e As Integer, f As Integer, g As Integer, h As Integer, _ 
I As Integer, j As Integer, k, m As Integer
    Dim begin As Date, eind As Date
    Dim duur As String
    Dim objSheet As Worksheet
    begin = TimeValue(Time)
    On Error Resume Next
    For Each objSheet In Application.Worksheets
        For a = 65 To 66: For b = 65 To 66: For c = 65 To 66
            For d = 65 To 66: For e = 65 To 66: For f = 65 To 66
                For g = 65 To 66: For h = 65 To 66: For I = 65 To 66
                    For j = 65 To 66: For k = 65 To 66: For m = 32 To 126
                        ActiveSheet.Unprotect Chr(a) & Chr(b) & _ 
 Chr(c) & Chr(d) & Chr(e) & Chr(f) & _ 
 Chr(g) & Chr(h) & Chr(I) & Chr(j) & Chr(k) & Chr(m)
                        If Ac…

Excel 2013: uniek aantal in draaitabel

Tot en met versie 2010 was het in Excel lastig om in een draaitabel een uniek aantal (DISTINCT COUNT) te tellen. We geven een voorbeeld op basis van een verkoperslijst. In deze lijst kunnen we zien welke verkopers welke artikelen hebben verkocht. Willen we nu in een draaitabel laten zien hoeveel artikelen een verkoper heeft verkocht, dan krijgen we wel de aantallen maar niet de unieke aantallen te zien.


Om toch de unieke aantallen te laten zien, hebben we een aantal stappen nodig.

Op het moment dat we de draaitabel invoegen, krijgen we in Excel 2013 dit dialoogvenster:


Onderaan zien we daar een nieuwe optie: Deze gegevens toevoegen aan het gegevensmodel. Deze optie moeten we aanvinken, voor we op OK klikken.

We krijgen dan een iets ander beeld dan normaal:


Normaliter krijgen we alleen de veldnamen. Nu zien we er het woord Bereik boven staan.

Voor het voorbeeld heb ik nu Verkoper toegevoegd aan Rijen en Artikelomschrijving aan Waarden.

Het resultaat is identiek aan het bovenste plaatje…

Excel: Speedometer met handleiding

Inleiding Echte speedometers met wijzertjes en zo kent het reguliere Excel niet. We kunnen wel zelf zoiets maken. En dat gaan we doen.
Hoe maken we zoiets?§We typen vanaf cel A1:

cijfers 1 1 1 1 1 1 1 1 1 1 10
De onderste 10 is de optelsom van de bovenste waarden.
§We maken hier een ringgrafiek van. §We wissen de labels. §We laten deze ring 270 graden laten draaien.


§Voor het onderste stuk kiezen we dan: Geen opvulling.