Database Properties

[NeoPa]

The following code, when added as a standard module, allows easy use and manipulation of the properties of a database :

Option Compare Database
Option Explicit
 
Private Const conNoProp As Integer = 3270
Private Const conVBToDB As String = "\2|3\3|4\4|6\5|7\6|5" & _
                                    "\7|8\8|10\11|1\14|20\17|2"
 
'SetProperty() requires that either intPType is set explicitly OR that
'              varPVal has a valid value if a new property is to be created.
Public Sub SetProperty(strPName As String _
                     , varPVal As Variant _
                     , Optional ByVal objVar As Object _
                     , Optional intPType As Integer = -1)
    Dim prpVal As DAO.Property
 
    Call SetObj(objVar)
    If PropertyExists(strPName, objVar) Then
        objVar.Properties(strPName) = varPVal
    Else
        If intPType = -1 Then intPType = DBVal(VarType(varPVal))
        Set prpVal = objVar.CreateProperty(strPName, intPType, varPVal)
        Call objVar.Properties.Append(prpVal)
    End If
End Sub
 
'GetProperty() returns the value of the specified property if found.
Public Function GetProperty(ByRef strPName As String, _
                            Optional ByVal objVar As Object) As Variant
    Call SetObj(objVar)
    If PropertyExists(strPName, objVar) Then _
        GetProperty = objVar.Properties(strPName)
End Function
 
'PropertyExists() returns True if the property exists and False if it doesn't.
Public Function PropertyExists(ByRef strPName As String _
                             , Optional ByVal objVar As Object) As Boolean
    Dim varTest As Variant
 
    On Error GoTo ErrorHandler
    Call SetObj(objVar)
    PropertyExists = True
    varTest = objVar.Properties(strPName)
    Exit Function
 
ErrorHandler:
    If Err <> conNoProp Then
        On Error GoTo 0
        Resume
    End If
    PropertyExists = False
End Function
 
'DelProperty() deletes the property if it exists.
Public Sub DelProperty(ByRef strPName As String _
                     , Optional ByVal objVar As Object)
    Call SetObj(objVar)
    If Not PropertyExists(strPName, objVar) Then Exit Sub
    Call objVar.Properties.Delete(strPName)
End Sub
 
'SetObj() sets objVar to CurrentDb() if it's not already set.
Private Sub SetObj(ByRef objVar As Object)
    If objVar Is Nothing Then Set objVar = CurrentDb()
End Sub
 
'DBVal() returns the value of the Type that is used in DAO
'  from the VBA equivalent.
Private Function DBVal(intVBVal) As Integer
    Dim intX As Integer
 
    intX = InStr(1, conVBToDB, "\" & intVBVal & "|")
    DBVal = Val(Mid(conVBToDB, intX + Len(intVBVal) + 2))
End Function

If it is required to determine which named properties are already available for a database then the following code, run from the Immediate Pane of the VBA IDE window, will show them for you :

Set db = CurrentDb : For Each prp in db.Properties : ?prp.Name : Next prp