Thursday, October 11, 2007

Access VBA Tricks

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