'Функуия вывода описаний всех таблиц базы данных

'Вывод в таблицу свойств полей всех таблиц базы

'Создает таблицу $$$TablProperty в которой:
'strTblName - имя таблицы
'strNameFld - имя поля таблицы
'lngPos - номер поля в таблице
'lngTypeFld - тип поля таблицы
'lngSizeFld - длинна поля таблицы
'strDefValFld - значение по умолчанию для поля
'strCaptionFld - Заголовок поля таблицы
'strDescrFld - примечание поля таблицы
Function tblTablProperty()
On Local Error GoTo tblTablProperty_ERR
  Const c_strTempTbl = "$$$TablProperty"
  
  Dim tblTemp As TableDef
  Dim rst As Recordset
  Dim tdf As TableDef
  Dim fld As Field
  Dim dbTemp As Database
  
  Set dbTemp = CurrentDb
  DoCmd.Hourglass (True)
    On Error Resume Next    ' Отложенный перехват ошибок.
      Set tblTemp = dbTemp.TableDefs(c_strTempTbl)
      If Err.Number =  0  Then DoCmd.DeleteObject acTable, c_strTempTbl
   
    On Local Error GoTo tblTablProperty_ERR
   
 dbTemp.Execute ( "Create table ["  & c_strTempTbl & _
        "](strTblName TEXT,lngPos LONG,"  _
       &  "strNameFld TEXT , lngTypeFld long, lngSizeFld LONG,"  _
       &  "strDefValFld text, strCaptionFld text,  strDescrFld text);" )
   
Set rst = dbTemp.OpenRecordset( "$$$TablProperty" )
For Each tdf In dbTemp.TableDefs
   If Left(tdf.Name,  4 ) <>  "MSys"  And tdf.Name <> c_strTempTbl Then
       For Each fld In tdf.Fields
           With rst
               .AddNew
               !strTblName = tdf.Name
               !lngPos = fld.OrdinalPosition
               !strNameFld = fld.Name
               !lngTypefld = fld.Type
               !lngSizeFld = fld.Size
               !strDefValFld = fld.DefaultValue
               !strCaptionFld = fld.Properties( "Caption" ).Value
               !strDescrFld = fld.Properties( "Description" ).Value
               .Update
           End With
       Next
   End If
Next
tblTablProperty_EXIT:
   DoCmd.Hourglass (False)
   Exit Function

tblTablProperty_ERR:
If Err.Number =  3270  Then Resume Next ' Нет описание поля

MsgBox  "Ошибка #: "  & Format$(Err.Number) & vbCrLf _
& Err.Description, vbInformation,  "tblTablProperty" 
Resume tblTablProperty_EXIT
End Function