To my knowledge, you cannot directly access the Custom Database Properties
from an ADP project. Maybe it's possible to do so by using the DSOFile.dll
library but I never checked personally. However, it's quite easy to add
custom properties to an ADP file by using the following code. Notice that
usually, you will find on the internet a version that use the Err_Handler in
order to determine if a named property already exists in the collection when
doing an insert. In the following version, this Err_Handler has been
replace by a Loop that scans the names already in the collection before
trying to make an insert. LogError() is any logging function that you might
use for logging errors. The varPropType (replaced here with
varPropType_Dummy) is not used because all properties (values) are stored as
string; not as Integer, String, etc.
' 2455 is for ADP, not for MDB.
Private Const cerrPropertyNotFound As Integer = 2455
Public Sub Debug_DisplayProperties()
Dim db As CurrentProject
Set db = Application.CurrentProject
Dim i
For i = 0 To db.Properties.Count - 1
Debug.Print db.Properties(i).name & ": " & db.Properties(i)
Next
End Sub
Public Sub SetProperty(ByVal strPropName As String, _
ByVal varPropType_Dummy As Integer, _
ByVal varPropValue As Variant)
Const cProcedureName As String = "SetProperty"
On Error GoTo Err_Handler
Dim db As CurrentProject
Set db = Application.CurrentProject
If (IsNull(varPropValue)) Then varPropValue = ""
Dim i
For i = 0 To db.Properties.Count - 1
If (db.Properties(i).name = strPropName) Then
db.Properties(strPropName).Value = varPropValue
GoTo Exit_Sub
End If
Next
db.Properties.Add strPropName, varPropValue
Exit_Sub:
On Error GoTo 0
Set db = Nothing
Exit Sub
Err_Handler:
' Err_Handler: used on older version.
Select Case err
Case cerrPropertyNotFound
db.Properties.Add strPropName, varPropValue
Case Else
' Call LogError(Err.Number, Err.Description, _
cModuleName & cProcedureName)
End Select
Resume Exit_Sub
End Sub
' GetProperty() : return True if the property exists in the collection,
' the property itself is returned in an ByRef parameter.
Public Function GetProperty(ByVal strPropName As String, _
ByRef strPropValue As Variant) As Boolean
Const cProcedureName As String = "GetProperty"
On Error GoTo Err_Handler
Dim db As CurrentProject
Set db = Application.CurrentProject
Dim i
For i = 0 To db.Properties.Count - 1
If (db.Properties(i).name = strPropName) Then
strPropValue = db.Properties(strPropName)
GetProperty = True
GoTo Exit_Function
End If
Next
GetProperty = False
Exit_Function:
On Error GoTo 0
Set db = Nothing
Exit Function
Err_Handler:
GetProperty = False
Select Case err
Case cerrPropertyNotFound
Case Else
' Call LogError(Err.Number, Err.Description, _
cModuleName & cProcedureName)
End Select
Resume Exit_Function
End Function
