Public Sub CreateDataDictionary()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim idx As DAO.Index
Dim i As Integer
Dim isKey As Boolean, isIdx As Boolean
Dim typ As String
Set db = CurrentDb
On Error Resume Next
db.Execute "DROP TABLE DataDictionary"
On Error GoTo 0
db.Execute "CREATE TABLE DataDictionary (" & _
"TableName TEXT(255), FieldName TEXT(255), FieldType TEXT(50), " & _
"FieldSize LONG, Required YESNO, KeyField YESNO, Indexed YESNO)"
For Each tdf In db.TableDefs
If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 4) <> "~TMP" Then
For Each fld In tdf.Fields
isKey = False: isIdx = False
For Each idx In tdf.Indexes
For i = 0 To idx.Fields.Count - 1
If idx.Fields(i).Name = fld.Name Then
isIdx = True
If idx.Primary Then isKey = True
End If
Next i
Next idx
typ = GetFieldType(fld)
db.Execute "INSERT INTO DataDictionary VALUES ('" & _
tdf.Name & "','" & fld.Name & "','" & typ & "'," & _
fld.Size & "," & IIf(fld.Required, "True", "False") & "," & _
IIf(isKey, "True", "False") & "," & _
IIf(isIdx, "True", "False") & ")"
Next fld
End If
Next tdf
MsgBox "Готово! Смотрите таблицу DataDictionary"
End Sub
Private Function GetFieldType(fld As DAO.Field) As String
Select Case fld.Type
Case dbText: GetFieldType = "Текстовый"
Case dbMemo: GetFieldType = "MEMO"
Case dbByte: GetFieldType = "Числовой (Байт)"
Case dbInteger: GetFieldType = "Числовой (Целое)"
Case dbLong
If (fld.Attributes And dbAutoIncrField) = dbAutoIncrField Then
GetFieldType = "Счетчик"
Else
GetFieldType = "Числовой (Длинное целое)"
End If
Case dbSingle: GetFieldType = "Числовой (Одинарное)"
Case dbDouble: GetFieldType = "Числовой (Двойное)"
Case dbCurrency: GetFieldType = "Денежный"
Case dbDate: GetFieldType = "Дата/время"
Case dbBoolean: GetFieldType = "Логический"
Case Else: GetFieldType = "Тип " & fld.Type
End Select
End Function