Property Object, Properties Collection Example (MDB)

The following example creates a property that is defined by Microsoft Access, but applies to DAO objects. Because the Microsoft Jet database engine cannot recognize properties defined by Microsoft Access, you must create a new Property object and append it to the Properties collection if you are setting the property for the first time.

You can use the same function to set a user-defined property on a Microsoft Access object or on a DAO object.

Note that you must specify the correct constant for the type argument when you create the property. If you're not certain which data type you should use, search the Help index for the individual property.

Function SetAccessProperty(obj As Object, strName As String, _
        intType As Integer, varSetting As Variant) As Boolean
    Dim prp As Property
    Const conPropNotFound As Integer = 3270

    On Error GoTo ErrorSetAccessProperty
    ' Explicitly refer to Properties collection.
    obj.Properties(strName) = varSetting
    obj.Properties.Refresh
    SetAccessProperty = True
    
ExitSetAccessProperty:
    Exit Function
    
ErrorSetAccessProperty:
    If Err = conPropNotFound Then
        ' Create property, denote type, and set initial value.
        Set prp = obj.CreateProperty(strName, intType, varSetting)
        ' Append Property object to Properties collection.
        obj.Properties.Append prp
        obj.Properties.Refresh
        SetAccessProperty = True
        Resume ExitSetAccessProperty
    Else
        MsgBox Err & ": " & vbCrLf & Err.Description
        SetAccessProperty = False
        Resume ExitSetAccessProperty
    End If
End Function

You could call the preceding function with a procedure such as the following:

Sub CallPropertySet()
    Dim dbs As Database, tdf As TableDef
    Dim blnReturn As Boolean
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    ' Return reference to Employees table.
    Set tdf = dbs.TableDefs!Employees
    ' Call SetAccessProperty function.
    blnReturn = SetAccessProperty(tdf, _
        "DatasheetFontItalic", dbBoolean, True)
    ' Evaluate return value.
    If blnReturn = True Then
        Debug.Print "Property set successfully."
    Else
        Debug.Print "Property not set successfully."
    End If
End Sub