How do I create a custom property with VBA in Access

Question

Hello

I am looking for a way to create a custom property in access with VBA.

Here's how far I am and where I am stuck:

A custom property's value (whose name is foo) can be read like so:

Dim cnt As Container
Dim doc As Document

Set cnt = DBEngine(0)(0).Containers!Databases
Set doc = cnt.Documents!userDefined

doc.Properties.Refresh
Debug.Print (doc.Properties!foo)

Similary, I can create a new property:

doc.Properties.Append doc.CreateProperty("vba created", dbText, "yes")

Now, the problem is:

Set doc = cnt.Documents!userDefined

does only work when I have already at least one custom property in the mdb. So, in order to create a custom property with VBA, I need to create a custom property.

I don't want to create this custom property manually (which would work) because I need to create a few MDBs with VBA and would like to do everything without manual intervention.

Thanks for any pointer to the right direction

Rene

EDIT for clarity

Here's a (trimmed down) code that I hope can be used to demonstrate what I cannot accomplish:

option explicit

public sub add_user_defined_property ()

on error goto error_lbl

  dim ac  as access.application
  dim cnt as dao.container
  dim doc as dao.document
  dim prp as dao.property
  dim db  as dao.database

  dim mdb_name as string
      mdb_name = "c:\temp\cust_prop_test.mdb"

  set ac = new access.application
  set db = ac.dbEngine.workspaces(0).createDatabase(mdb_name, dbLangGeneral, 0)

  ac.openCurrentDatabase(mdb_name)

' set cnt = DBEngine(0)(0).Containers("Databases")
  set cnt = db.containers("Databases")

  ' following line throws "3265 Item not found in this collection"
  set doc = cnt.Documents!UserDefined

  set prp = doc.createProperty("MyNewProperty", dbText, "MyNewProperty")
  doc.properties.append prp

' for Each prp In doc.Properties
'     debug.print "Name = " & prp.Name & ", value = " & prp.Value
' next

error_lbl:

  select case err.number
         case 3265
              msgBox("Expected error occured")
         case else
              msgBox(err.number & vbCrLf & err.description)
  end select

end sub

This code throws the 3265 (Item not found in this collection) error at the line reading

  set doc = cnt.Documents!UserDefined

because (as I think) the mdb is newly created and does not yet contain the userDefined member in cnt.Documents. It would work, if I had already manually added such a property, that is, by opening the mdb file with access, then going to menu File->Database Properties then going to the custom tab.

Answer 1

EDIT re Comment

Set cnt = DBEngine(0)(0).Containers("Databases")
Set doc = cnt.Documents!UserDefined

Set prp = doc.CreateProperty("MyNewProperty", dbText, "MyNewProperty")
doc.Properties.Append prp

For Each prp In doc.Properties
    Debug.Print "Name = " & prp.Name & ", value = " & prp.Value
Next

Here is some sample code from Less Than Dot, where you will find more details.

'---------------------------------------------------------------------------------------
' Procedure : CreateDBStrProp
' Purpose   : Create a Custom Database Property of dbText (string) type
' Arguments : strPropName As String-the Property Name
'           : strPropValue As String-the Property Value
'---------------------------------------------------------------------------------------

Function CreateDBStrProp(strPropName As String, strPropValue As String) As Boolean
On Error GoTo Err_CreateDBStrProp

    Dim db As DAO.Database
    Dim prp As Property

    Set db = DBEngine(0)(0)

    '' First we verify the Property Exists to avoid an error
    If ExistsDBProperty(strPropName) = False Then
        Set prp = db.CreateProperty(strPropName, dbText, strPropValue)
        db.Properties.Append prp
    Else
        Set prp = db.Properties(strPropName)
        prp.Value = strPropValue
        MsgBox "DBProperty " & strPropName & " already exists.        " _
            & vbCrLf & vbCrLf & "Property value was set." _
            , vbExclamation
    End If

    CreateDBStrProp = True

Exit_CreateDBStrProp:
    Set prp = Nothing
    Set db = Nothing
    Exit Function

Err_CreateDBStrProp:
    CreateDBStrProp = False
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
    " In procedure CreateDBStrProp"
    Resume Exit_CreateDBStrProp
End Function