This may be a bit of overkill...
I had a similar issue several weeks ago. After digging
around quite a lot, I concluded that the best method I had
available was to use ADOX.
Here's an piece of what I arrived at. (Be sure to check
off "Microsoft ADO Ext. 2.x for DDL and Security in your
Tools | References, and to fix any text wrapping....)
HTH!
DBS (David Staas)
==================================================
Private Sub GetFieldDesc_ADO()
On Error GoTo Err_GetFieldDescription
Dim MyDB As New ADOX.Catalog
Dim MyTable As ADOX.Table
Dim MyField As ADOX.Column
Dim strObjectName As String
Dim intObjectID As Integer
Dim strObjectType As String
Dim strFieldName As String
Dim strFieldType As String
Dim strFieldSize As String
Dim strFieldScale As String
Dim strFieldPrecision As String
Dim strFieldDescription As String
Dim strQuery As String
strObjectType = "Local Table"
MyDB.ActiveConnection = CurrentProject.Connection
For Each MyTable In MyDB.Tables
If MyTable.Type = "TABLE" And _
MyTable.Name <> "tblObjects" And _
MyTable.Name <> "tblTableFields" Then
strObjectName = MyTable.Name
For Each MyField In MyTable.Columns
strFieldName = MyField.Name
strFieldType = funcEnumDataTypes(MyField.Type)
strFieldSize = MyField.DefinedSize
strFieldScale = MyField.NumericScale
strFieldPrecision = MyField.Precision
strFieldDescription = MyField.Properties
("Description")
intObjectID = DLookup
("[ObjectID]", "tblObjects", "[ObjectName] = '" &
strObjectName & "'")
strQuery = "INSERT INTO tblTableFields "
strQuery = strQuery & "( ObjectID, FieldName,
FieldType, FieldSize, TableFieldRemark ) "
strQuery = strQuery & "SELECT " & intObjectID
& ", "
strQuery = strQuery & "'" & strFieldName
& "', "
strQuery = strQuery & "'" & strFieldType
& "', "
strQuery = strQuery & strFieldSize & ", "
strQuery = strQuery & "'" & funcParseOut
(strFieldDescription, "'") & "';"
DoCmd.SetWarnings False
DoCmd.RunSQL strQuery
DoCmd.SetWarnings True
Next MyField
End If
Next MyTable
Set MyDB.ActiveConnection = Nothing
Set MyDB = Nothing
Bye_GetFieldDescription:
Exit Sub
Err_GetFieldDescription:
Beep
MsgBox Err.Description, vbExclamation
Resume Bye_GetFieldDescription
End Sub
==================================================