
Can't create and set a new custom database property
Hello,
I have a VB6 routine to create a new database (Access97),
a new database custom property and to set a new value to this property.
When I run this code:
Private Sub Form_Load()
Dim wrkDefault As Workspace
Dim dbsnew As Database
Dim strName As String
Dim strValue As String
Dim prp As Property
' Get default Workspace
Set wrkDefault = DBEngine.Workspaces(0)
'Make sure there isn't already a file with the name of new database.
If Dir("C:\Temp\test.mdb") <> "" Then Kill "C:\Temp\test.mdb"
'Create a new database.
Set dbsnew = wrkDefault.CreateDatabase("C:\Temp\test.mdb", dbLangGeneral,
dbVersion30)
'Create new Database property
Set dbsnew = DBEngine(0).OpenDatabase("C:\Temp\test.mdb")
Set prp = dbsnew.CreateProperty("UserDefined", dbText, "InitialValue")
dbsnew.Properties.Append prp
Set dbsnew = Nothing
'Set property name variable
strName = "VersionNumber"
'Set property value variable
strValue = "1.0"
If SetCustomProperty(strName, dbText, strValue) <> True Then
'Error occured trying to set property.
MsgBox "Error occured trying to set property."
End If
MsgBox "Done"
Unload Me
End Sub
Public Function SetCustomProperty(strPropName As String, intPropType As
Integer, strPropValue As String) As Boolean
Dim dbs As Database, cnt As Container
Dim doc As Document, prp As Property
Const conPropertyNotFound = 3270 'Property not found error.
Set dbs = DBEngine(0).OpenDatabase("C:\Temp\test.mdb") '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 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
I' ve got Run-time error '3265':
Item not found in this collection.
It happened on Set doc = cnt.Documents!UserDefined
Could you please advise me how to fix this problem?
Thanks,
Gennady