La configuración de Excel en VBA es:

Untitled

Ejemplos de ficheros:

Biblio.accdb

tocnun_modelos.mdb

northbrick_2019.mdb

Ejemplo con Biblio.accdb

Sub RecordsetExcel()
    Dim bd As Database
    Dim rs As Recordset
    Dim HojaNueva As Object
    Dim Filename As String
    
    Filename = "C:\\Users\\nserrano\\Downloads\\Biblio.accdb"
    'Filename = "C:\\Users\\nserrano\\Downloads\\tocnun_modelos.mdb"
    
    'Abre la base de datos Filename 
    Set bd = DBEngine.Workspaces(0).OpenDatabase(Filename)
    'Abre un conjunto de registros con todos los registros de la tabla clientes
    Set rs = bd.OpenRecordset("select [Year Published], count(*) as titles_coount from titles Group by [Year Published]")
    'Inserta una nueva hoja de cálculo en el libro activo
    Set HojaNueva = ThisWorkbook.Sheets.Add(Type:=xlWorksheet)
    'Sitúa los nombres de campo en la fila 1 de la nueva hoja de cálculo
    For h = 0 To rs.Fields.Count - 1
        HojaNueva.[a1].Offset(0, h).Value = rs.Fields(h).Name
    Next h
    'Copia el conjunto de registros en Excel
    'HojaNueva.[a2].CopyFromRecordset rs
    
    j = 1
    Do While (Not rs.EOF)
        For h = 0 To rs.Fields.Count - 1
            HojaNueva.[a1].Offset(j, h).Value = rs.Fields(h).Value
        Next h
        j = j + 1
        rs.MoveNext
    Loop
    'Cierra el conjunto de registros
    rs.Close
    'Cierra la base de datos
    bd.Close
End Sub

Si no funciona DAO 3.6, con ADODB

Sub RecordsetExcel()
    Dim conn As Object
    Dim rs As Object
    Dim Filename As String
    
    Filename = "C:\\Users\\nserrano\\Downloads\\Biblio.accdb"
    'Filename = "C:\\Users\\nserrano\\Downloads\\tocnun_modelos.mdb"
    
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Filename

    ' Create a recordset
    Set rs = CreateObject("ADODB.Recordset")
    
    Sql = "select [Year Published], count(*) as titles_coount from titles Group by [Year Published]"
    
    rs.Open Sql, conn
        
    'Inserta una nueva hoja de cálculo en el libro activo
    Set HojaNueva = ThisWorkbook.Sheets.Add(Type:=xlWorksheet)
    'Sitúa los nombres de campo en la fila 1 de la nueva hoja de cálculo
    For h = 0 To rs.Fields.Count - 1
        HojaNueva.[a1].Offset(0, h).Value = rs.Fields(h).Name
    Next h
    'Copia el conjunto de registros en Excel
    'HojaNueva.[a2].CopyFromRecordset rs
    
    j = 1
    Do While (Not rs.EOF)
        For h = 0 To rs.Fields.Count - 1
            HojaNueva.[a1].Offset(j, h).Value = rs.Fields(h).Value
        Next h
        j = j + 1
        rs.MoveNext
    Loop
    'Cierra el conjunto de registros
    rs.Close
    'Cierra la base de datos
End Sub

To print the tables of a database:

   	Set rs = conn.OpenSchema(20, Array(Empty, Empty, Empty, "TABLE"))
    
    ' Loop through the recordset to display table names
    Do Until rs.EOF
        Debug.Print rs("TABLE_NAME")
        rs.MoveNext
    Loop
    rs.Close

Tablas y campos:

Sub GetTableFieldDetails()
    Dim conn As Object
    Set conn = CreateObject("ADODB.Connection")
    
    ' Set the connection string
    dbPath = "C:\\Users\\nserrano\\Downloads\\Biblio.accdb"
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
    
    ' Retrieve table names using OpenSchema method
    Dim rsTables As Object
    Set rsTables = CreateObject("ADODB.Recordset")
    Set rsTables = conn.OpenSchema(20, Array(Empty, Empty, Empty, "TABLE"))
    
    ' Loop through the tables
    Do Until rsTables.EOF
        Dim tableName As String
        tableName = rsTables("TABLE_NAME")
        
        ' Output the table name
        Debug.Print "Table Name: " & tableName
        
        ' Retrieve and display the fields (columns) for the current table
        Dim rsFields As Object
        Set rsFields = CreateObject("ADODB.Recordset")
        Set rsFields = conn.OpenSchema(4, Array(Empty, Empty, tableName))
        
        ' Loop through the fields of the current table
        Do Until rsFields.EOF
            Dim fieldName As String
            fieldName = rsFields("COLUMN_NAME")
            
            ' Output the field name
            Debug.Print "  Field Name: " & fieldName
            
            ' Retrieve and display additional field details
            Debug.Print "    Data Type: " & rsFields("DATA_TYPE")
            Debug.Print "    Is Nullable: " & rsFields("IS_NULLABLE")
            
            rsFields.MoveNext
        Loop
        
        rsFields.Close
        rsTables.MoveNext
    Loop
    
    ' Close the recordsets and connection
    rsTables.Close
    conn.Close
End Sub