Here goes
The code below:
1. Goes thru all your tables except system tables
2. Creates a table to store the info you need
3. Gets the
Tablename
field names
field types
field data
and populates the newly created table.
This can be used to source your report.
It does various checks for things along the way - you can step thru it at your leisure.
Copy from here
and paste into a module.
Sub Print_tableNames()
Dim mydb As Database
Set mydb = CurrentDb
Dim rst As DAO.Recordset, intI As Integer
Dim fld As Field
Dim tdf As TableDef
'This checks for, and if found will delete the table
Dim tbl As TableDef
Dim stablename As String
'THis deletes any old tempTDF table if it exists
For Each tbl In mydb.TableDefs
stablename = tbl.Name
If stablename = "tbl_TableInfo" Then
mydb.TableDefs.Delete (stablename)
End If
Next
'Recreate it
Dim tbl_TableInfoTDF As TableDef
Set tbl_TableInfoTDF = mydb.CreateTableDef("tbl_TableInfo"
With tbl_TableInfoTDF
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' your database
.Fields.Append .CreateField("Tablename", dbText)
.Fields.Append .CreateField("FieldName", dbText)
.Fields.Append .CreateField("Data_Type", dbText)
.Fields.Append .CreateField("Data", dbMemo)
End With
'cycle round the recordset and populate a the newly created temptools table
mydb.TableDefs.Append tbl_TableInfoTDF
mydb.TableDefs.Refresh
' Now that your receiving table is ready to be populated begin your process
For Each tdf In mydb.TableDefs
If InStr(1, tdf.Name, "msys"
= 0 Then
Print_Field_Names (tdf.Name) ' excludes system tables
Else
End If
Next tdf
MsgBox "done"
End Sub
Sub Print_Field_Names(tblname As String)
Dim mydb As Database
Set mydb = CurrentDb
Dim rst As DAO.Recordset, intI As Integer
Dim fld As Field
Dim TableInfoRS As Recordset
Dim Datavalue As String
Set TableInfoRS = mydb.OpenRecordset("tbl_TableInfo", dbOpenDynaset)
TableInfoRS.AddNew
TableInfoRS.Update
TableInfoRS.MoveFirst
DoEvents
Set rst = mydb.OpenRecordset(tblname, dbOpenDynaset)
'check for no records int table
If rst.BOF = -1 And rst.EOF = -1 Then
Datavalue = "Empty"
Else
rst.MoveFirst
End If
For Each fld In rst.Fields
TableInfoRS.Edit
TableInfoRS!Tablename = tblname
TableInfoRS!FieldName = fld.Name
TableInfoRS!Data_Type = FieldType(fld.Type)
'if there is no current record you can't get a value
'so Datavalue of "Empty" is written to the table
If Datavalue <> "Empty" Then
TableInfoRS!Data = fld.Value
Else
TableInfoRS!Data = Datavalue
End If
TableInfoRS.Update
TableInfoRS.AddNew
TableInfoRS.Update
TableInfoRS.MoveNext
'Debug.Print tdf.Name & "," & fld.Name & "," & FieldType(fld.Type) & "," & fld.Size & " , "; fld.Value
Next
rst.Close
TableInfoRS.Close
Set mydb = Nothing
End Sub
Function FieldType(intType As Integer) As String
Select Case intType
Case dbBoolean
FieldType = "dbBoolean"
Case dbByte
FieldType = "dbByte"
Case dbInteger
FieldType = "dbInteger"
Case dbLong
FieldType = "dbLong"
Case dbCurrency
FieldType = "dbCurrency"
Case dbSingle
FieldType = "dbSingle"
Case dbDouble
FieldType = "dbDouble"
Case dbDate
FieldType = "dbDate"
Case dbText
FieldType = "dbText"
Case dbLongBinary
FieldType = "dbLongBinary"
Case dbMemo
FieldType = "dbMemo"
Case dbGUID
FieldType = "dbGUID"
End Select
End Function
