How to loop through all Tables in an MS Access DB
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
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
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