Option Compare Database
Option Explicit

Function MakeDocumentSet()
    Dim z
    z = MakeTablesFields()
    z = MakeQueriesFields()
    Beep
End Function

Function MakeTablesFields()
    Const tbl$ = "TablesFields"
    Dim db As Database, tdf As TableDef, rst As Recordset, sql$, txt$, x As Long, y As Long
    sql$ = "CREATE TABLE " & tbl$ & " (TableName TEXT(64), FieldName TEXT(64), FieldType TEXT(10), FieldSize SHORT);"
    Set db = CurrentDb
    ' delete and then re-create the destination table
    On Error Resume Next
    DoCmd.DeleteObject acTable, tbl$
    On Error GoTo 0
    DoCmd.RunSQL sql$
    ' add the tables & fields
    Set rst = db.OpenRecordset(tbl$)
    For y = 0 To db.TableDefs.Count - 1
        Set tdf = db.TableDefs(y)
        txt$ = tdf.Name
        If Left(txt$, 4) <> "MSys" And txt$ <> tbl$ Then
            For x = 0 To tdf.Fields.Count - 1
                rst.AddNew
                rst!tablename = tdf.Name
                rst!FieldName = tdf.Fields(x).Name
                rst!FieldType = accDataType(tdf.Fields(x).Type)
                rst!FieldSize = tdf.Fields(x).Size
                rst.Update
            Next x
        End If
    Next y
    rst.Close
End Function

Function MakeQueriesFields()
    Const tbl$ = "QueriesFields"
    Dim db As Database, qdf As QueryDef, rst As Recordset, sql$, x As Long, y As Long, crit As String
    sql$ = "CREATE TABLE " & tbl$ & " (QueryName TEXT(64), FieldName TEXT(64), SourceTable TEXT(64), SourceField TEXT(64), FieldType TEXT(10), FieldSize SHORT);"
    Set db = CurrentDb
    ' delete and then re-create the destination table
    On Error Resume Next
    DoCmd.DeleteObject acTable, tbl$
    On Error GoTo 0
    DoCmd.RunSQL sql$
    ' add the queries, fields & source tables
    Set rst = db.OpenRecordset(tbl$)
    For y = 0 To db.QueryDefs.Count - 1
        Set qdf = db.QueryDefs(y)
        For x = 0 To qdf.Fields.Count - 1
            rst.AddNew
            rst!queryname = qdf.Name
            rst!FieldName = qdf.Fields(x).Name
            rst!SourceTable = qdf.Fields(x).SourceTable
            rst!SourceField = qdf.Fields(x).SourceField
            rst!FieldType = accDataType(qdf.Fields(x).Type)
            crit = "[TableName] = '" & qdf.Fields(x).SourceTable & "' And [FieldName] = '" & qdf.Fields(x).SourceField & "'"
            rst!FieldSize = DLookup("[FieldSize]", "TablesFields", crit)
            rst.Update
        Next x
    Next y
    rst.Close
End Function

Function accDataType(TypeNumber)
    Select Case TypeNumber
        Case 1
            accDataType = "Yes/No"
        Case 2
            accDataType = "Byte"
        Case 3
            accDataType = "Integer"
        Case 4
            accDataType = "Long"
        Case 5
            accDataType = "Currency"
        Case 6
            accDataType = "Single"
        Case 7
            accDataType = "Double"
        Case 8
            accDataType = "Date/Time"
        Case 10
            accDataType = "Text"
        Case 11
            accDataType = "OLE Object"
        Case 12
            accDataType = "Memo"
    End Select
End Function