Sub Create_tblTableFields()
''''Reference Field object definition https://msdn.microsoft.com/en-us/library/office/ff193203.aspx
Dim db As DAO.Database
Dim tblLoop As DAO.TableDef
Dim fldLoop As DAO.Field
Dim TD1 As DAO.TableDef
Dim QD1 As DAO.QueryDef
Dim TempSet1 As DAO.Recordset
Dim strDatabase As String
Dim ThisDB As DAO.Database
Dim CountTables As Integer
''''On Error GoTo Create_tblTableFields_Error
On Error GoTo Err_Create_tblTableFields
'strDatabase = "C:\hartman\LinkDB2.mdb"
strDatabase = Forms!frmPrintDoc!txtDBName
CountTables = 0
Set ThisDB = CurrentDb()
If strDatabase = "" Then
Set db = CurrentDb()
Else
Set db = DBEngine.Workspaces(0).OpenDatabase(strDatabase)
End If
db.Containers.Refresh
''' Set QD1 = ThisDB.QueryDefs!QdeltblTableFields
''' QD1.Execute
Set TD1 = ThisDB.TableDefs!tblTableFields
Set TempSet1 = TD1.OpenRecordset
' Loop through TableDefs collection.
For Each tblLoop In db.TableDefs
' Enumerate Fields collection of each
' TableDef object.
CountTables = CountTables + 1
Forms!frmPrintDoc!txtTableCount = CountTables
Forms!frmPrintDoc!txtTableName = tblLoop.Name
Forms!frmPrintDoc.Repaint
If Left(tblLoop.Name, 4) = "MSys" Or Left(tblLoop.Name, 2) = "xx" Or Left(tblLoop.Name, 2) = "zz" Or Left(tblLoop.Name, 1) = "~" Then
Else
For Each fldLoop In tblLoop.Fields
TempSet1.AddNew
TempSet1!TableName = tblLoop.Name
TempSet1!FieldName = fldLoop.Name
TempSet1!OrdinalPosition = fldLoop.OrdinalPosition
TempSet1!AllowZeroLength = fldLoop.AllowZeroLength
TempSet1!DefaultValue = fldLoop.DefaultValue
TempSet1!Size = fldLoop.Size
TempSet1!Required = fldLoop.Required
TempSet1!Type = fldLoop.Type
TempSet1!ValidationRule = fldLoop.ValidationRule
TempSet1!Attributes = fldLoop.Attributes
On Error Resume Next ' the following property is only available when it is not null
TempSet1!Description = fldLoop.Properties("Description")
TempSet1!FieldType = GetType(fldLoop.Type)
TempSet1!Caption = fldLoop.Properties("Caption")
If fldLoop.Attributes And dbAutoIncrField Then 'performs bitwise operation
TempSet1!AutoNum = True
TempSet1!Required = True
Else
TempSet1!AutoNum = False
End If
TempSet1.Update
Next fldLoop
End If
Next tblLoop
Exit_Create_tblTableFields:
db.Close
Exit Sub
Err_Create_tblTableFields:
Select Case Err.Number
Case 3043, 3055
MsgBox "Please select a valid database. Error #" & Err.Number, vbOKOnly
Case 91 ' db was not opened so it cannot be closed.
Exit Sub
Case Else
MsgBox Err.Number & " (" & Err.Description & ") in procedure Create_tblTableFields of Module DocumentCollections"
End Select
Resume Exit_Create_tblTableFields
On Error GoTo 0
Exit Sub