Programmation ADO

'Option Explicit
' d'après ...\Program Files\Microsoft Office\Office\Samples
Dim T_xxx
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cat As ADOX.Catalog
Dim fld As ADODB.Field

    Sub schematiser_base()
        Dim chemin As String, fichier As String
        
        'effacement de la zone dictionnaire
        Range("A4:D100").Clear 'adapter la surface suivant base
        
       ' Création de l'objet Connexion
        chemin = ThisWorkbook.Path
        fichier = chemin & "\" & nomdetabase.mdb
        Set conn = New ADODB.Connection
        With conn
            ' Définition du fournisseur OleDB pour la connexion
            .Provider = "Microsoft.JET.OLEDB.4.0"
            ' Ouverture d'une connexion vers la base
            .Open fichier
        End With
        
        Set cat = New ADOX.Catalog
        Set cat.ActiveConnection = conn
        ' énumère les tables de la base commencant par "T_"
                For Each T_xxx In cat.Tables
            If Left(T_xxx.Name, 2) = "T_" Then
                lister_champs
            End If
        Next
        conn.Close
    End Sub

                           
    Sub lister_champs()
    
    lig = Range("B100").End(xlUp).Row + 2
    With Cells(lig, 1)
        .Value = T_xxx.Name
        .Font.Bold = True
    End With
        
    Set rst = New ADODB.Recordset
        With rst
            .ActiveConnection = conn
            .Open "SELECT * FROM " & T_xxx.Name & ""
        End With
        
        For Each fld In rst.Fields
            Cells(lig, 2) = fld.Name
            Cells(lig, 3) = dire(fld.Type)
            Cells(lig, 4) = fld.DefinedSize
            lig = lig + 1
        Next fld
      
    Set rst = Nothing
        
    End Sub

Function dire(num As Long) As String
Select Case num
    ' Il existe 39 types; les + utilisés:
    Case 3
    dire = "Entier long"
    Case 4
    dire = "réel simple"
    Case 5
    dire = "Réel double"
    Case 6
    dire = "monétaire 4 après virgule"
    Case 7
    dire = "date"
    Case 11
    dire = "booléen"
    Case 202
    dire = "texte type access"
    Case 203
    dire = " texte type mémo"
End Select
End Function