Загрузка данных


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