Programmatically using a Database Object's Description

Programmatically using a Database Object's Description

If you wish to change a Database Object's (i.e. Table, Query, Form, Report, Macro, Module) Description using code, then it is quite easy, as long as the Description already exists. If this property doesn't exist, then it raises an error, which can be trapped, and then a Description created. Here is a sample function that will amend an existing Description, or create a new Description if needed, or delete an existing Description if passed an empty string:

Sub sAlterObjectDescription(lngObjectType As Long, strObjectName As String, varDescription As Variant)
    On Error GoTo E_Handle
    Dim db As Database
    Set db = CurrentDb
    Select Case lngObjectType
        Case acTable
           db.TableDefs(strObjectName).Properties("Description") = varDescription
        Case acQuery
           db.QueryDefs(strObjectName).Properties("Description") = varDescription
        Case acForm
           db.Containers("Forms").Documents(strObjectName).Properties("Description") = varDescription
        Case acReport
           db.Containers("Reports").Documents(strObjectName).Properties("Description") = varDescription
        Case acMacro
           db.Containers("Scripts").Documents(strObjectName).Properties("Description") = varDescription
        Case acModule
           db.Containers("Modules").Documents(strObjectName).Properties("Description") = varDescription
    End Select
sExit:
    Set db = Nothing
    Application.RefreshDatabaseWindow
    Exit Sub
E_Handle:
    Select Case Err.Number
        Case 3270 ' Property does not exist
            Call sCreateObjectDescription(lngObjectType, strObjectName, varDescription)
        Case 3385 ' Trying to set it to a Null value - therefore delete the Description
            Call sDeleteObjectDescription(lngObjectType, strObjectName)
        Case Else
            MsgBox Err.Description, vbOKOnly + vbCritical, "Error (Amending): " & Err.Number
    End Select
    Resume sExit
End Sub

Sub sCreateObjectDescription(lngObjectType As Long, strObjectName As String, varDescription As Variant)
    On Error GoTo E_Handle
    Dim db As Database
    Dim prp As Property
    Dim obj As Object
    Set db = CurrentDb
    Select Case lngObjectType
        Case acTable
            Set obj = db.TableDefs(strObjectName)
        Case acQuery
            Set obj = db.QueryDefs(strObjectName)
        Case acForm
            Set obj = db.Containers("Forms").Documents(strObjectName)
        Case acReport
            Set obj = db.Containers("Reports").Documents(strObjectName)
        Case acMacro
            Set obj = db.Containers("Scripts").Documents(strObjectName)
        Case acModule
            Set obj = db.Containers("Modules").Documents(strObjectName)
    End Select
    Set prp = obj.CreateProperty("Description", dbText, varDescription)
    obj.Properties.Append prp
    obj.Properties.Refresh
sExit:
    Set prp = Nothing
    Set obj = Nothing
    Set db = Nothing
    Exit Sub
E_Handle:
    Select Case Err.Number
        Case 3385 ' Trying to create an empty description - therefore ignore error
        Case Else
            MsgBox Err.Description, vbOKOnly + vbCritical, "Error (Adding): " & Err.Number
    End Select
    Resume sExit
End Sub

Sub sDeleteObjectDescription(lngObjectType As Long, strObjectName As String)
    On Error GoTo E_Handle
    Dim db As Database
    Dim obj As Object
    Set db = CurrentDb
    Select Case lngObjectType
        Case acTable
            Set obj = db.TableDefs(strObjectName)
        Case acQuery
            Set obj = db.QueryDefs(strObjectName)
        Case acForm
            Set obj = db.Containers("Forms").Documents(strObjectName)
        Case acReport
            Set obj = db.Containers("Reports").Documents(strObjectName)
        Case acMacro
            Set obj = db.Containers("Scripts").Documents(strObjectName)
        Case acModule
            Set obj = db.Containers("Modules").Documents(strObjectName)
    End Select
    obj.Properties.Delete "Description"
    obj.Properties.Refresh
sExit:
    Set obj = Nothing
    Set db = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description, vbOKOnly + vbCritical, "Error (Deleting) : " & Err.Number
    Resume sExit
End Sub

You can then call this procedure in the following manner:

Call sAlterObjectDescription(acTable,"tblName","New Description")
Call sAlterObjectDescription(acTable,"tblName","Changed Description")
Call sAlterObjectDescription(acTable,"tblName","")

Which will firstly create a Description for the table called 'tblName', then amend it, and finally delete it.

Top

Last modified at 06/06/2006 14:58:05