In one of my projects, I had to build data dictionary from Access Database. All my efforts of trying to copy and paste the column descriptions into excel were fruitless. Based on my previous VB experience, I tried to use VBA to extract the details.
I simply started with trying to get tall table names using simple scripts. After various iterations I was able to get the table names and their descriptions. Here is the script that I used to get the table names and their descriptions from the current database.
Function DisplayTableDescriptions()
On Error GoTo Err_DisplayTableDescriptions
Dim DB As DAO.Database
Dim tbl As DAO.TableDef
Dim prp As DAO.Property
Dim NoDescription As Boolean
Dim DescriptionText As String
Dim TableNameText As String
Set DB = CurrentDb
For Each tbl In DB.TableDefs
NoDescription = False
Set prp = tbl.Properties("description")
If NoDescription Then
Debug.Print "Table: " & tbl.Name
DescriptionText = "No Description"
TableNameText = tbl.Name
Else
Debug.Print "Table: " & tbl.Name & " " & prp.Value
DescriptionText = prp.Value
TableNameText = tbl.Name
End If
Next
Exit_DisplayTableDescriptions:
DB.Close
Exit Function
Err_DisplayTableDescriptions:
If Err.Number = 3270 Then
NoDescription = True
Resume Next
Else
MsgBox Err.Description
Resume Exit_DisplayTableDescriptions
End If
End Function
Now the next task was to get column names of individual tables and extract the column descriptions. I was able to get the column name but the description property was little challenging. Again the following script provided me with the column names and their descriptions. Because of time constraint, I had to execute script for each table in my database. Thanks to copy/paste feature, it was a piece of cake.
Sub DisplayTableColumnDescriptions()
Dim rstCounterparty As Database
Dim rstTables As Recordset
Dim fldTableDef As Field
Dim prpLoop As Property
Dim ColumnDetailsText As String
Set rstCounterparty = OpenDatabase("c:/tablename.mdb")
Debug.Print ""
Debug.Print ""
Debug.Print " TableOne Details:"
Debug.Print ""
Set rstTables = rstCounterparty.OpenRecordset("TableOne")
ProcessTable rstTables
Debug.Print ""
Debug.Print " TableTwo:"
Debug.Print ""
Set rstTables = rstCounterparty.OpenRecordset("TableTwo")
ProcessTable rstTables
Debug.Print ""
Debug.Print "tdCPInfo_UParents Details:"
Debug.Print ""
rstCounterparty.Close
End Sub
Sub ProcessTable(rstTables As Recordset)
Dim fldRecordset As Field
' Function to process the passed table
' Assign a Field object from different Fields
' collections to object variables.
For field_count = 0 To rstTables.Fields.Count - 1
'Set fldTableDef = _
'rstCounterparty.TableDefs(0).Fields(field_count)
Set fldRecordset = rstTables.Fields(field_count)
' Print report.
FieldOutput "Recordset", fldRecordset
Next field_count
rstTables.Close
End Sub
Sub FieldOutput(strTemp As String, fldTemp As Field)
' Report function for FieldX.
Dim prpLoop As Property
'Debug.Print "Valid Field properties in " & strTemp
' Enumerate Properties collection of passed Field
' object.
For Each prpLoop In fldTemp.Properties
' Some properties are invalid in certain
' contexts (the Value property in the Fields
' collection of a TableDef for example). Any
' attempt to use an invalid property will
' trigger an error.
On Error Resume Next
If prpLoop.Name = "Name" Then
ColumnDetailsText = prpLoop.Value
'Debug.Print " " & prpLoop.Name & " = " & prpLoop.Value
End If
If prpLoop.Name = "Description" Then
ColumnDetailsText = ColumnDetailsText & " " & prpLoop.Value
'Debug.Print " " & prpLoop.Name & " = " & prpLoop.Value
Debug.Print ColumnDetailsText
'ColumnDetailsText = "\n"
End If
On Error GoTo 0
Next prpLoop
End Sub
Happy Learning
