Технологии программирования (MS ACCESS, VBA, VB, ASP) - Функция получения свойств таблиц БД

Функция получения свойств таблиц БД

Автор В.Ким

12.08.2003 г.

Функция создает 3 служебные таблицы:
- со списком таблиц базы ' (кроме MSys*) с их основными свойствами
- со списком полей таблиц базы
- со списком свойств полей таблиц базы

Option Compare Database
Option Explicit

'Встроенный архивариус выводит информацию о таблице
'в очень неудобном для работы формате
'Насколько удобнее, если свойства таблиц представить в виде БД

'Просто вставить код в новый модуль исследуемой БД
'и стартовать Sub GETTablesINFO

'Ким Владимир Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script

Private Sub GETTablesINFO()
'START ME!
'Получение INFO по таблицам базы
'Программа создаст
'- таблицу ~TBL со списком таблиц базы
' (кроме MSys*)с их основными свойствами
'- таблицу ~FLD со списком полей таблиц базы
'- таблицу ~PRP со списком свойств полей таблиц базы
'- связи между таблицами ~TBL,~FLD,~PRP
'Заполнив таблицы, откроет ~TBL
'таблицы ~FLD,~PRP будут открываться каскадно
Dim r1 As DAO.Recordset
Dim r2 As DAO.Recordset
Dim r3 As DAO.Recordset

Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Dim Id_Tbl As Long
Dim Id_fld As Long
Dim i As Long, ii As Long

DropTbl
CreateTBL1
CreateTBL2
CreateTBL3
CreateTBL4

Set r1 = CurrentDb.OpenRecordset("select * from [~tbl]")
Set r2 = CurrentDb.OpenRecordset("select * from [~fld]")
Set r3 = CurrentDb.OpenRecordset("select * from [~prp]")

On Error Resume Next
i = 0
ii = CurrentDb.TableDefs.Count
'цикл по таблицам кроме системных
For Each tdf In CurrentDb.TableDefs
i = i + 1
Debug.Print "TableDef (" & tdf.Name & ")" & i & " of " & ii & " Start:" & Time
    If Left(tdf.Name, 4) = "msys" Then GoTo nextTDF

   With r1
'пишем
    .AddNew
        ![Name] = tdf.Name
        ![Updatable] = tdf.Updatable
        ![DateCreated] = tdf.DateCreated
        ![LastUpdated] = tdf.LastUpdated
        ![Connect] = tdf.Connect
        ![Attributes] = tdf.Attributes
        ![SourceTableName] = tdf.SourceTableName
        ![RecordCount] = tdf.RecordCount
        ![ValidationRule] = tdf.ValidationRule
        ![ValidationText] = tdf.ValidationText
        ![ConflictTable] = tdf.ConflictTable
        ![ReplicaFilter] = Nz(tdf.ReplicaFilter, "")
        ![Orientation] = tdf.Properties("Orientation").Value
        ![OrderByOn] = tdf.Properties("OrderByOn").Value
        ![Description] = tdf.Properties("Description").Value
        ![Filter] = tdf.Properties("Filter").Value
        ![SubdatasheetName] = tdf.Properties("SubdatasheetName").Value
        ![LinkChildFields] = tdf.Properties("LinkChildFields").Value
        ![LinkMasterFields] = tdf.Properties("LinkMasterFields").Value
        ![SubdatasheetHeight] = tdf.Properties("SubdatasheetHeight").Value
        ![SubdatasheetExpanded] = tdf.Properties("SubdatasheetExpanded").Value
    .Update
    .MoveLast
       Id_Tbl = r1(0).Value
    End With

' цикл по полям таблицы
    For Each fld In tdf.Fields
       With r2
'пишем
        .AddNew
        ![IDTBL] = Id_Tbl
        ![NameField] = fld.Name
        .Update
        .MoveLast
       Id_fld = r2(0).Value
        End With
'цикл по свойствам поля таблицы
        For Each prp In fld.Properties
       With r3
'пишем
        .AddNew
        ![idFLD] = Id_fld
        ![PropertyName] = prp.Name
        ![PropertyValue] = prp.Value
        .Update
        End With
        Next prp

    Next fld
nextTDF:
Next tdf

Debug.Print "Finish: " & Time
Set r1 = Nothing
Set r2 = Nothing
Set r3 = Nothing

DoCmd.OpenTable "~tbl", acViewNormal, acReadOnly

End Sub

Private Sub DropTbl()
On Error Resume Next
CurrentDb.Execute "drop table [~prp]"
CurrentDb.Execute "drop table [~fld]"
CurrentDb.Execute "drop table [~tbl]"
End Sub

Private Sub CreateTBL1()
'создание таБлицы СПИСОК ТАБЛИЦ БАЗЫ И ИХ СВОЙСТВА
CurrentDb.Execute "CREATE TABLE [~TBL] ([idTBL] counter," & _
"[Name] text," & _
"[Updatable] logical," & _
"[DateCreated] date," & _
"[LastUpdated] date," & _
"[Connect] memo," & _
"[Attributes] memo," & _
"[SourceTableName] memo," & _
"[RecordCount] Long," & _
"[ValidationRule] memo," & _
"[ValidationText] memo," & _
"[ConflictTable] memo," & _
"[ReplicaFilter] memo," & _
"[Orientation] memo," & _
"[OrderByOn] memo," & _
"[Description] memo," & _
"[Filter] memo," & _
"[SubdatasheetName] memo," & _
"[LinkChildFields] memo," & _
"[LinkMasterFields] memo," & _
"[SubdatasheetHeight] Long," & _
"[SubdatasheetExpanded] memo," & _
"CONSTRAINT [id_Key] PRIMARY KEY ([idTBL]));"
End Sub

Private Sub CreateTBL2()
'создание таБлицы СПИСОК ПОЛЕЙ ТАБЛИЦ БАЗЫ
CurrentDb.Execute "CREATE TABLE [~FLD] ([idFLD] counter," & _
"[IDTBL] Long," & _
"[NameField] text," & _
"CONSTRAINT [id_Key] PRIMARY KEY ([idFLD]));"
End Sub

Private Sub CreateTBL3()
'создание таБлицы СПИСОК СВОЙСТВ ПОЛЕЙ ТАБЛИЦ БАЗЫ
CurrentDb.Execute "CREATE TABLE [~PRP] ([idPRP] counter," & _
"[idFLD] Long," & _
"[PropertyName] text," & _
"[PropertyValue] memo," & _
"CONSTRAINT [id_Key] PRIMARY KEY ([idPRP]));"
End Sub

Private Sub CreateTBL4()
'Устанавливаем связь между таблицами
CurrentDb.Execute "ALTER TABLE [~fld] ADD CONSTRAINT [~ref1] " & _
"FOREIGN KEY (IDtbl) REFERENCES [~tbl] (idtbl)"
CurrentDb.Execute "ALTER TABLE [~prp] ADD CONSTRAINT [~ref2] " & _
"FOREIGN KEY (IDfld) REFERENCES [~fld] (idfld)"
End Sub

Коментарии (3)

1 Написал(а) Даниил, в 19:04 14.11.2009
Большое спасибо!!

2 Написал(а) GRAF, в 08:14 30.11.2009
Премного благодарен!

3 Написал(а) Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , в 09:33 23.07.2018
Спасибо, отличная вещь!

Добавить коментарий
Имя:
E-mail
Коментарий:
Код:*