Sub ListTblsAndFields()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim curTable As String
Dim newTable As String
Dim counter As Integer
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
Set rst = conn.OpenSchema(adSchemaColumns)
curTable = ""
newTable = ""
counter = 1
Do Until rst.EOF
curTable = rst!table_Name
If (curTable <> newTable) Then
newTable = rst!table_Name
Debug.Print "Table: " & rst!table_Name
counter = 1
End If
Debug.Print "Field" & counter & ": " & rst!Column_Name
counter = counter + 1
rst.MoveNext
Loop
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub