In the following example, you can set or create a custom user-defined property that will appear on the Custom tab of the DatabaseName Properties dialog box. For example, you could call the SetCustomProperty function to add a new property called LastUserName to the UserDefined Document object in the database. The arguments passed to the SetCustomProperty function are those required to execute the CreateProperty method.
Dim strName As String, strValue As String
' Set property name variable.
strName = "LastUserName"
' Set property value variable.
strValue = InputBox("Please enter your full name")
If SetCustomProperty(strName, dbText, strValue) <> True Then
' Error occurred trying to set property.
MsgBox "Error occurred trying to set property."
End If
Function SetCustomProperty(strPropName As String, intPropType _
As Integer, strPropValue As String) As Integer
Dim dbs As Database, cnt As Container
Dim doc As Document, prp As Property
Const conPropertyNotFound = 3270 ' Property not found error.
Set dbs = CurrentDb ' Define Database object.
Set cnt = dbs.Containers!Databases ' Define Container object.
Set doc = cnt.Documents!UserDefined ' Define Document object.
On Error GoTo SetCustom_Err
doc.Properties.Refresh
' Set custom property name. If error occurs here it means
' property doesn't exist and needs to be created and appended
' to Properties collection of Document object.
Set prp = doc.Properties(strPropName)
prp = strPropValue ' Set custom property value.
SetCustomProperty = True
SetCustom_Bye:
Exit Function
SetCustom_Err:
If Err = conPropertyNotFound Then
Set prp = doc.CreateProperty(strPropName, intPropType, strPropValue)
doc.Properties.Append prp ' Append to collection.
Resume Next
Else ' Unknown error.
SetCustomProperty = False
Resume SetCustom_Bye
End If
End Function
The next example demonstrates how to display information from the Summary tab of the DatabaseName Properties dialog box. The application's title, subject, and author are displayed in text box controls on a form. In this example, if the property hasn't already been set, "None" is returned from the procedure. If an unknown error occurs, a zero-length string (" ") is returned.
Private Sub Form_Open(Cancel As Integer)
Dim strTitle As String, strSubject As String, strAuthor As String
strTitle = "Title"
strSubject = "Subject"
strAuthor = "Author"
Me!txtTitle = GetSummaryInfo(strTitle)
Me!txtSubject = GetSummaryInfo(strSubject)
Me!txtAuthor = GetSummaryInfo(strAuthor)
End Sub
Function GetSummaryInfo(strPropName As String) As String
Dim dbs As Database, cnt As Container
Dim doc As Document, prp As Property
' Property not found error.
Const conPropertyNotFound = 3270
On Error GoTo GetSummary_Err
Set dbs = CurrentDb
Set cnt = dbs.Containers!Databases
Set doc = cnt.Documents!SummaryInfo
doc.Properties.Refresh
GetSummaryInfo = doc.Properties(strPropName)
GetSummary_Bye:
Exit Function
GetSummary_Err:
If Err = conPropertyNotFound Then
Set prp = doc.CreateProperty(strPropName, dbText, "None")
' Append to collection.
doc.Properties.Append prp
Resume
Else
' Unknown error.
GetSummaryInfo = ""
Resume GetSummary_Bye
End If
End Function