On May 6, 11:13*am, "mlthomas00 7" <u43434@uwewrot e:
Hi,
A client asked for a code book (all fields, descriptions, tables, etc.) from
our Access database. *Has anyone had to do this? *It seems to me theremust
be a way to extract all this information from Access.
I use a report called tblFields with the following code. The report
groups on table names and shows the field descriptions. Sometimes
this is eough for the client, sometimes I send it into Word and
explain a little more what's going on. I can copy the report to any
application for a quick look of what's what.
Private Sub Report_Open(Can cel As Integer)
' Arvin Meyer 12/7/1995
' Modified 3/17/2000 Tim Mills-Groninger
' Finds and lists all fields in all tables
On Error Resume Next
Me.CreateNewTab leWithChecking = Null 'check for tblFields, make if not
present
Dim db As Database
Dim rst As Recordset
Dim tdf As TableDef
Dim fld As Field
Dim intI As Integer
Dim intJ As Integer
Dim strDesc As String
Set db = CurrentDb()
' Clean out the "working" table tblFields
db.Execute "Delete * From tblFields"
' Open the table for data entry
Set rst = db.OpenRecordse t("tblFields" , DB_OPEN_TABLE,
DB_APPENDONLY)
' Outer loop for tables
For intI = 0 To db.TableDefs.Co unt - 1
Set tdf = db.TableDefs(in tI)
' Skip system tables
If Left(tdf.Name, 4) <"MSys" Then
' Now loop through fields
For intJ = 0 To tdf.Fields.Coun t - 1
Set fld = tdf.Fields(intJ )
rst.AddNew
rst!TableName = tdf.Name
rst!FieldName = fld.Name
rst!FieldNumber = fld.OrdinalPosi tion
Select Case fld.Type
Case dbDate
rst!DataType = "Date/Time"
Case dbText
rst!DataType = "Text"
Case dbMemo
rst!DataType = "Memo"
'Case dbHyperlinkFiel d
' rst!DataType = "Hyperlink"
Case dbBoolean
rst!DataType = "Yes/No"
Case dbInteger
rst!DataType = "Integer"
Case dbLong
rst!DataType = "Long Integer"
Case dbCurrency
rst!DataType = "Currency"
Case dbSingle
rst!DataType = "Single"
Case dbDouble
rst!DataType = "Double"
Case dbByte
rst!DataType = "Byte"
Case dbLongBinary
rst!DataType = "OLE Field"
Case Else
rst!DataType = "Unknown"
End Select
strDesc = ""
' The Resume Next will avoid an error if there is no
Description
strDesc = fld.Properties( "Descriptio n")
rst!Description = IIf(IsNull(fld. Properties("Des cription")),
"", strDesc)
rst.Update
Next intJ
End If
Next intI
rst.Close
End Sub
Function CreateNewTableW ithChecking()
' check for table fields, and if not present, make one
' Helen Feddema - the Access Archon, modified from her column
' in Woody's Access Watch Vol2 No11
On Error GoTo ErrorHandler
Dim dbs As DAO.Database
Dim strTable As String
Dim strSQL As String
Dim tdf As TableDef
Dim lngResult As Long
Set dbs = CurrentDb
strTable = "tblFields"
Set tdf = dbs.TableDefs(s trTable)
'dbs.TableDefs. Delete strTable
CreateNewTable: 'Runs only if "tblFields" does not exist
strSQL = "CREATE TABLE " & strTable & "(TableName TEXT (50),
FieldName TEXT (50), "
strSQL = strSQL + " FieldNumber INTEGER, DataType TEXT (50),
DefaultValue TEXT (50)"
strSQL = strSQL + " , Description TEXT (150), Constraint myCon
Primary Key (TableName, FieldName));"
dbs.Execute strSQL
ErrorHandlerExi t:
Exit Function
ErrorHandler:
Select Case Err.Number
Case 3265
GoTo CreateNewTable
Case Else
'MsgBox "Error No: " & Err.Number & "; Description: " &
Err.Description
Resume ErrorHandlerExi t
End Select
End Function
