I do not know of any SQL in Access that would do this.
I do something like this with VBA code and a table
Copy the following code into a module and add a table to your database, that
conforms to the initial comments in the first function. Once the tabl is
built run the fBuildDbDictionary function.
'----------------- Code Starts -------------------
'Code Module: modBuildDbDictionary
Option Compare Database
Option Explicit
Public Function fBuildDataDictionary()
'Given table tbl_DbDictionary with
'Fields:ItemID Autonumber; SortOrder Number Long
'tblName Text 25; fldName Text 25
'PrimaryKey Text 25 ; DataType Text 25;
'FieldSize Text 25; Field Description Text 255
'Fill table with information from the properties of the fields
Dim dbAny As DAO.Database
Dim tblAny As DAO.TableDef
Dim fldAny As DAO.Field
Dim strTableName As String, strTableDescription As String
Dim strSQL As String
Dim rstAny As DAO.Recordset
Dim intOrder As Integer
On Error GoTo fBuildDataDictionary_Err
Set dbAny = CurrentDb()
'Clear tbl_DbDictionary
strSQL = "DELETE * FROM tbl_DbDictionary"
dbAny.Execute strSQL, dbFailOnError
Set rstAny = dbAny.OpenRecordset("tbl_DbDictionary")
For Each tblAny In dbAny.TableDefs
strTableName = tblAny.Name
'grab the table description if available
'strTableDescription = tblAny.Properties("Description")
If InStr(1, strTableName, "Msys", vbTextCompare) = 0 _
And InStr(1, strTableName, "~") = 0 _
And InStr(1, strTableName, "src_") <> 1 _
And InStr(1, strTableName, "zzz") <> 1 _
And strTableName <> "tbl_DbDictionary" _
Then
For Each fldAny In tblAny.Fields
If InStr(1, fldAny.Name, "S_", vbTextCompare) <> 1 And InStr(1, fldAny.Name,
"GEN_", vbTextCompare) <> 1 Then
With rstAny
.AddNew
intOrder = intOrder + 1
!SortOrder = intOrder 'fldAny.OrdinalPosition + 1
!tblName = strTableName
!fldName = fldAny.Name
!DataType = fGetFieldTypeName(fldAny.Type)
If !DataType = "Memo" Then
'Memo fields use a 12-byte pointer
'OLE may also use 12-byte pointers - need to check.
!FieldSize = 12
Else
!FieldSize = fldAny.Size
End If
'=======================================================================
' Added additional data to table
'=======================================================================
If Len(fldAny.DefaultValue) > 0 Then
!DefaultValue = fldAny.DefaultValue
End If
If Len(fldAny.ValidationRule) > 0 Then
!ValidationRule = fldAny.ValidationRule
End If
If Len(fldAny.ValidationText) > 0 Then
!ValidationText = fldAny.ValidationText
End If
If fldAny.Required = True Then
!RequiredField = "Required"
Else
!RequiredField = Null
End If
'=======================================================================
'Autoincrement field is primary key in my databases
If fldAny.Attributes And dbAutoIncrField Then
!PrimaryKey = "True"
End If
.Update
End With
End If 'Starts with S_
Next fldAny
End If
strTableDescription = vbNullString
Next tblAny
sGetFieldDescriptions
MsgBox "Finished building table - tbl_DbDictionary"
fBuildDataDictionary = True
Exit Function
fBuildDataDictionary_Err:
Select Case Err.Number
Case 3270, 3265
Resume Next
Case Else
MsgBox Err.Number & ": " & Err.Description, , "ERROR:
fBuildDataDictionary"
End Select
End Function
Public Function fGetFieldTypeName(fldAnyType) As String
Dim strAny As String
Select Case fldAnyType
Case dbBigInt
strAny = "Big Integer"
Case dbBinary
strAny = "Binary"
Case dbBoolean
strAny = "Boolean"
Case dbByte
strAny = "Byte"
Case dbChar
strAny = "Char"
Case dbCurrency
strAny = "Number (Currency)"
Case dbDate
strAny = "Date/Time"
Case dbDecimal
strAny = "Decimal"
Case dbDouble
strAny = "Number (Long)"
Case dbFloat
strAny = "Number (Float)"
Case dbGUID
strAny = "GUID"
Case dbInteger
strAny = "Number (Integer)"
Case dbLong
strAny = "Number (Long)"
Case dbLongBinary
strAny = "Long Binary (OLE Object)"
Case dbMemo
strAny = "Memo"
Case dbNumeric
strAny = "Numeric"
Case dbSingle
strAny = "Number (Single)"
Case dbText
strAny = "Text"
Case dbTime
strAny = "Time"
Case dbTimeStamp
strAny = "Time Stamp"
Case dbVarBinary
strAny = "VarBinary"
Case Else
strAny = "Unknown Type"
End Select
fGetFieldTypeName = strAny
End Function
Public Sub sGetFieldDescriptions()
'Loop through all the tables and fields in data table
'Collect the field descriptions
Dim dbAny As DAO.Database
Dim rstDictionary As DAO.Recordset
Dim tblAny As DAO.TableDef
Dim strTable As String, strTablePrior As String, strFieldname As String
On Error GoTo sGetFieldDescriptions_Error
Set dbAny = CurrentDb()
Set rstDictionary = dbAny.OpenRecordset("tbl_DbDictionary")
With rstDictionary
strTablePrior = ""
While Not .EOF
strFieldname = !fldName
strTable = !tblName
If strTablePrior <> strTable Then
Set tblAny = dbAny.TableDefs(strTable)
End If
.Edit
!FieldDescription =
tblAny.Fields(strFieldname).Properties("Description")
.Update
strTablePrior = !tblName
.MoveNext
Wend
End With
Exit Sub
sGetFieldDescriptions_Error:
Select Case Err.Number
Case 3270, 3265
Resume Next
Case Else
MsgBox Err.Number & ": " & Err.Description, , "sGetFieldDescriptions"
End Select
End Sub
Public Function fGetTableDescription(strTableName As String) As String
Dim dbAny As DAO.Database
Dim strTableDescription As String
On Error GoTo fGetTableDescription_Error
Set dbAny = CurrentDb()
strTableDescription =
dbAny.TableDefs(strTableName).Properties("Description")
fGetTableDescription_Exit:
Set dbAny = Nothing
fGetTableDescription = strTableDescription
Exit Function
fGetTableDescription_Error:
Select Case Err.Number
Case 3270, 3265
strTableDescription = vbNullString
Resume fGetTableDescription_Exit
Case Else
MsgBox Err.Number & ": " & Err.Description, , "ERROR:
fGetTableDescription"
End Select
End Function
'----------------------- Code ends --------------------------
