Функция создает 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
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
' цикл по полям таблицы 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