creating a Data Dictionary

MyTable with fields
table text255
field text255
display text255
type text255
lookupsql memo
description memo
size number

Option Compare Database
Option Explicit

Sub main()
GenerateDataDictionary ("MyTable")
End Sub

Public Function GenerateDataDictionary(aDataDictionaryTable As String)
'*** Usage: GenerateDataDictionary("MyDataDictionaryTable")
'*** Extracts the information about the tables for the data dictionary and inserts it to a table
'***-- aDataDictionaryTable - Data dictionary table

Dim tdf As TableDef, fldCur As Field, colTdf As TableDefs
Dim rstDatadict As Recordset
Dim i As Integer, j As Integer, k As Integer
Dim FieldDataType As String
Dim dbs As Database

On Error GoTo fail
Set rstDatadict = CurrentDb.OpenRecordset(aDataDictionaryTable)
Set dbs = CurrentDb
Set colTdf = dbs.TableDefs
'Go hrough the database and get a tablename

For Each tdf In dbs.TableDefs
    'Do what you want with the table names here.
    rstDatadict.AddNew
    rstDatadict.Update
    
    rstDatadict.AddNew
    rstDatadict![Table] = tdf.Name
    rstDatadict![Field] = "----------------------------"
    rstDatadict![Display] = "----------------------------"
    rstDatadict![Type] = ""
    rstDatadict.Update
    
    rstDatadict.AddNew
    rstDatadict![Table] = "Table Description:"
    For j = 0 To tdf.Properties.Count - 1
        If tdf.Properties(j).Name = "Description" Then
            rstDatadict![Field] = tdf.Properties(j).Value
        End If
    Next j
    rstDatadict.Update
    
    rstDatadict.AddNew
    rstDatadict.Update

    For i = 0 To tdf.Fields.Count - 1
        Set fldCur = tdf.Fields(i)
        rstDatadict.AddNew
        rstDatadict![Table] = tdf.Name
        rstDatadict![Field] = fldCur.Name
        rstDatadict![Size] = fldCur.Size

        Select Case fldCur.Type
        Case 1
            FieldDataType = "Yes/No"
        Case 4
            FieldDataType = "Number"
        Case 8
            FieldDataType = "Date"
        Case 10
            FieldDataType = "String"
        Case 11
            FieldDataType = "OLE Object"
        Case 12
            FieldDataType = "Memo"
        Case Else ' Other values.
            FieldDataType = fldCur.Type
        End Select

        rstDatadict![Type] = FieldDataType
        
        For j = 0 To tdf.Fields(i).Properties.Count - 1
            If fldCur.Properties(j).Name = "Description" Then
                rstDatadict![Description] = fldCur.Properties(j).Value
            End If

            If fldCur.Properties(j).Name = "Caption" Then
                rstDatadict![Display] = fldCur.Properties(j).Value
            End If

            If fldCur.Properties(j).Name = "Rowsource" Then
                rstDatadict![LookupSQL] = fldCur.Properties(j).Value
            End If
        Next j

        rstDatadict.Update

    Next i
Debug.Print " " & tdf.Name
Next tdf

MsgBox ("Table Generated")
exithere:

    Exit Function
    
fail:
    Call MsgBox("Error: " & Err & "  Desc: " & Err.Description)
    Resume exithere
End Function