Hi,
I wrote a procedure some time back to loop through tables
and fields. It calls a custom function to return data
types. The module was kind of quick and dirty (no
comments or error handler), but I think it may help you
see how you can loop through tables and fields. The code
was written in DAO, so you will need a reference to it.
If you also have a reference to ADO you should explicitly
reference the object variables (at least the
recordsets). I now explicitly reference my object
variables by habit, but as I mentioned this was done a
while back.
This code deleted all records in tables named
tzdoc_Tables and tzdoc_TablesDetail, and then appended
all table names to the first and the detailed field
information to the second (as well as the link to the
table name). You can gleam the field names from the
code. Let me know if you have any questions after
looking at it.
-Ted Allen
Here is the code for the sub (watch the wrapping)
Public Sub Gen_Dbase_Structure()
Dim dbsCurrent As Database, tdfLoop As TableDef,
strTableName As String, LineNo As Integer, rstMaster As
Recordset
Dim qdef As QueryDef, rstDetail As Recordset,
DetailLineNo As Integer, fldLoop As Field
Set dbsCurrent = CurrentDb
LineNo = 0
With dbsCurrent
Set qdef = .CreateQueryDef("", "DELETE tzdoc_Tables.*
FROM tzdoc_Tables;")
qdef.Execute
Set qdef = .CreateQueryDef("", "DELETE
tzdoc_TablesDetail.* FROM tzdoc_TablesDetail;")
qdef.Execute
Set rstMaster = .OpenRecordset("tzdoc_Tables")
Set rstDetail = .OpenRecordset("tzdoc_TablesDetail")
For Each tdfLoop In .TableDefs
strTableName = tdfLoop.Name
If Left(strTableName, 4) <> "MSys" Then
LineNo = LineNo + 1
With rstMaster
Debug.Print " " & LineNo & " " &
tdfLoop.Name
.AddNew
!TableIDNo = LineNo
!TableName = strTableName
.Update
End With
DetailLineNo = 0
For Each fldLoop In tdfLoop.Fields
DetailLineNo = DetailLineNo + 1
With rstDetail
.AddNew
!TableIDLink = LineNo
!FieldID = DetailLineNo
!FieldName = fldLoop.Name
!DataType = FieldType(fldLoop.Type)
!DataSize = fldLoop.Size
!IsRequired = fldLoop.Required
.Update
End With
Next fldLoop
End If
Next tdfLoop
End With
Set rstMaster = Nothing
Set rstDetail = Nothing
End Sub
Here is the code for the custom function:
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
