How to loop through all Tables in an MS Access DB

Question

I need to read the properties of over 100 tables in an Access 2003 database and write those details - table name, field name, type and size - to a file for further documentation.

I can find nothing from web searches about reading field properties, just field values ...

Can someone please tell me what recordset variables I have to declare (and the syntax) to loop through all of the tables in the DB and extract the field name, type and size from each of them? I will be writing the results to a text file, but I think I can handle that! :)

I'm at a standstill until I can sort this out. It took me a day to document TWO tables manually. Some of the tables have well over 100 fields.

Pelasgian

Answer 1

The Database Documenter wizard with these options should give you what you want with the least effort.

If that approach is not satisfactory, you can use custom VBA code to gather the information you want. You can retrieve the names of the tables in your database by looping through the DAO TableDefs collection.

Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
    ' ignore system and temporary tables
    If Not (tdf.name Like "MSys*" Or tdf.name Like "~*") Then
        Debug.Print tdf.name
    End If
Next
Set tdf = Nothing
Set db = Nothing

To get the field details you want, adapt Allen Browne's TableInfo() function ... substitute file write statements for the Debug.Print statements. Note that function uses 2 helper functions, GetDescrip and FieldTypeName, both of which are included in that linked page.

Here is an Immediate window output sample from TableInfo() for a table in my database --- I think it includes the field information you want.

TableInfo "foo"
FIELD NAME    FIELD TYPE    SIZE          DESCRIPTION
==========    ==========    ====          ===========
id            AutoNumber     4            
MyNumber      Long Integer   4            
MyText        Text           255          
bar           Long Integer   4            
==========    ==========    ====          ===========

After you've adapted the function, call it from the For Each tdf loop in the sample above and feed it each tdf.name:

TableInfo tdf.name

Polypody

Answer 2

You're going to have to tweak this a bit, it's designed to copy tables from one database to another but it should be a great starting point.

    ' Database.
    Dim dbRep As DAO.Database
    Dim dbNew As DAO.Database

    ' For copying tables and indexes.
    Dim tblRep As DAO.TableDef
    Dim tblNew As DAO.TableDef
    Dim fldRep As DAO.Field
    Dim fldNew As DAO.Field
    Dim idxRep As DAO.Index
    Dim idxNew As DAO.Index

    ' For copying data.
    Dim rstRep As DAO.Recordset
    Dim rstNew As DAO.Recordset
    Dim rec1 As DAO.Recordset
    Dim rec2 As Recordset
    Dim intC As Integer

    ' For copying table relationships.
    Dim relRep As DAO.Relation
    Dim relNew As DAO.Relation

    ' For copying queries.
    Dim qryRep As DAO.QueryDef
    Dim qryNew As DAO.QueryDef

    ' For copying startup options.
    Dim avarSUOpt
    Dim strSUOpt As String
    Dim varValue
    Dim varType
    Dim prpRep As DAO.Property
    Dim prpNew As DAO.Property

    ' For importing forms, reports, modules, and macros.
    Dim appNew As New Access.Application
    Dim doc As DAO.Document

    ' Open the database, not in exclusive mode.
    Set dbRep = OpenDatabase(Forms!CMDB_frmUpgrade.TxtDatabase, False)


    ' Open the new database
    Set dbNew = CurrentDb

    DoEvents

    ' Turn on the hourglass.
    DoCmd.Hourglass True

    '********************
    Debug.Print "Copy Tables"
    '********************
If Forms!CMDB_frmUpgrade.CkTables = True Then
    Forms!CMDB_frmUpgrade.LstMessages.addItem "Copying Tables:"

    ' Loop through the collection of table definitions.
    For Each tblRep In dbRep.TableDefs
    Set rec1 = dbRep.OpenRecordset("SELECT MSysObjects.Name FROM MsysObjects WHERE ([Name] = '" & tblRep.Name & "') AND ((MSysObjects.Type)=4 or (MSysObjects.Type)=6)")

    If rec1.EOF Then
      XF = 0
    Else
      XF = 1
    End If

        ' Ignore system tables and CMDB tables.
        If InStr(1, tblRep.Name, "MSys", vbTextCompare) = 0 And _
            InStr(1, tblRep.Name, "CMDB", vbTextCompare) = 0 And _
            XF = 0 Then

            '***** Table definition
            ' Create a table definition with the same name.
            Set tblNew = dbNew.CreateTableDef(tblRep.Name)
            Forms!CMDB_frmUpgrade.LstMessages.addItem "--> " & tblRep.Name & ""

            ' Set properties.
            tblNew.ValidationRule = tblRep.ValidationRule
            tblNew.ValidationText = tblRep.ValidationText

            ' Loop through the collection of fields in the table.
            For Each fldRep In tblRep.Fields

                ' Ignore replication-related fields:
                ' Gen_XXX, s_ColLineage, s_Generation, s_GUID, s_Lineage
                If InStr(1, fldRep.Name, "s_", vbTextCompare) = 0 And _
                    InStr(1, fldRep.Name, "Gen_", vbTextCompare) = 0 Then

                    '***** Field definition
                    Set fldNew = tblNew.CreateField(fldRep.Name, fldRep.Type, _
                        fldRep.Size)

                    ' Set properties.
                    On Error Resume Next
                    fldNew.Attributes = fldRep.Attributes
                    fldNew.AllowZeroLength = fldRep.AllowZeroLength
                    fldNew.DefaultValue = fldRep.DefaultValue
                    fldNew.Required = fldRep.Required
                    fldNew.Size = fldRep.Size

                    ' Append the field.
                    tblNew.Fields.Append fldNew
                    'On Error GoTo Err_NewShell
                End If
            Next fldRep

            '***** Index definition

            ' Loop through the collection of indexes.
            For Each idxRep In tblRep.Indexes

                ' Ignore replication-related indexes:
                ' s_Generation, s_GUID
                If InStr(1, idxRep.Name, "s_", vbTextCompare) = 0 Then

                    ' Ignore indices set as part of Relation Objects
                    If Not idxRep.Foreign Then

                        ' Create an index with the same name.
                        Set idxNew = tblNew.CreateIndex(idxRep.Name)

                        ' Set properties.
                        idxNew.Clustered = idxRep.Clustered
                        idxNew.IgnoreNulls = idxRep.IgnoreNulls
                        idxNew.Primary = idxRep.Primary
                        idxNew.Required = idxRep.Required
                        idxNew.Unique = idxRep.Unique

                        ' Loop through the collection of index fields.
                        For Each fldRep In idxRep.Fields
                            ' Create an index field with the same name.
                            Set fldNew = idxNew.CreateField(fldRep.Name)
                            ' Set properties.
                            fldNew.Attributes = fldRep.Attributes
                            ' Append the index field.
                            idxNew.Fields.Append fldNew
                        Next fldRep

                        ' Append the index to the table.
                        tblNew.Indexes.Append idxNew
                    End If
                End If
            Next idxRep

            ' Append the table.
            dbNew.TableDefs.Append tblNew
        End If
    Next tblRep

Goddord

Thanks to both of you. I can see what I need to do now. Great stuff. – Pelasgian

Answer 3

Following sub will export all table name, field name, type, required , default value to an excel sheet

Sub TableDef()
 Dim def As TableDef
 Dim wb As Object
 Dim xL As Object
 Dim lngRow As Long
 Dim f As Field
 Set xL = CreateObject("Excel.Application")
 xL.Visible = True
 Set wb = xL.workbooks.Add
 lngRow = 2
 For Each def In CurrentDb.TableDefs
   For Each f In def.Fields
     With wb.sheets("Sheet1")
           .Range("A" & lngRow).Value = def.Name
           .Range("B" & lngRow).Value = f.Name
           .Range("C" & lngRow).Value = f.Type
           .Range("D" & lngRow).Value = f.Size
           .Range("E" & lngRow).Value = f.Required
           .Range("F" & lngRow).Value = f.DefaultValue
            lngRow = lngRow + 1
    End With
   Next
 Next
End Sub

Nguyen