Here is some code I use to return the value of a "user defined database
property" I named "Appversion"
PS: sorry for not applying standard naming conventions I can't get used to
it and too old to adapt.
Const VersionPropertyName = "AppVersion"
Const PropertyNotFound = 3270
Function GetAppVersion(dbs As Database) As Integer
2240 Dim Cnt As Container, Doc As Document, prp As Property, AppVersion
As Single
2250 On Local Error GoTo GetSummary_Err
2255 Set Cnt = dbs.Containers!Databases
2260 Set Doc = Cnt.Documents!Userdefined
2265 Doc.Properties.Refresh
2270 AppVersion = Doc.Properties(VersionPropertyName)
GetSummary_Bye:
2280 Set Cnt = Nothing
2285 Set Doc = Nothing
2290 GetAppVersion = Round(AppVersion, 2)
2300 Exit Function
GetSummary_Err:
2305 AppVersion = 0
2310 If Err = PropertyNotFound Then
2315 Set prp = Doc.CreateProperty(VersionPropertyName, dbDouble, 0)
2320 Doc.Properties.Append prp
2325 Set prp = Nothing
2330 Resume
2335 Else
2340 If Error_message() Then Resume 0
2345 Resume GetSummary_Bye
2350 End If
End Function
Function SetAppVersion(dbs As Database, AppVersion As Integer) As Boolean
2355 Dim Cnt As Container, Doc As Document, prp As Property
2360 On Local Error GoTo SetCustom_Err
2370 Set Cnt = dbs.Containers!Databases
2375 Set Doc = Cnt.Documents!Userdefined
2380 Doc.Properties.Refresh
2385 Set prp = Doc.Properties(VersionPropertyName)
2390 prp = AppVersion
2395 SetAppVersion = True
SetCustom_Bye:
2400 Set Cnt = Nothing: Set Doc = Nothing: Set prp = Nothing
2410 Exit Function
SetCustom_Err:
2415 If Err = PropertyNotFound Then
2420 Set prp = Doc.CreateProperty(VersionPropertyName, dbDouble,
AppVersion)
2425 Doc.Properties.Append prp
2430 Resume Next
2435 Else
2440 If Error_message() Then Resume 0
2445 SetAppVersion = False
2450 Resume SetCustom_Bye
2455 End If
End Function
rgds
AndreG