Question

我正在寻找一种在使用VBA访问时创建自定义属性的方法。

这是我到底有多远以及我被困在哪里：

自定义属性的值（其名称为 foo ）可以这样读取：

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)

同样，我可以创建一个新属性：

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

现在，问题是：

Set doc = cnt.Documents!userDefined

仅在我在mdb中至少有一个自定义属性时才起作用。因此，为了使用VBA创建自定义属性，我需要创建一个自定义属性。

我不想手动创建这个自定义属性（这会起作用），因为我需要使用VBA创建一些MDB，并希望在没有人工干预的情况下完成所有操作。

感谢任何指向正确方向的指针

雷

为清晰起见编辑

这是一个（修剪过的）代码，我希望可以用它来演示我无法完成的任务：

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

此代码在读取行

时抛出3265（此集合中未找到的项目）错误

  set doc = cnt.Documents!UserDefined

因为（我认为）mdb是新创建的，并且还没有包含cnt.Documents中的 userDefined 成员。它可以工作，如果我已经手动添加了这样的属性，即通过打开带访问权限的mdb文件，然后转到菜单File-＆gt; Database Properties然后转到自定义选项卡。

Answer 1

问题是您使用createdatabase来创建数据库文件。以这种方式创建MDB文件只会创建MSysDB文档对象。

要在尝试创建数据库并且能够在documents！userdefined对象中设置属性时，必须从应用程序创建数据库。

为此，请更改以下行：

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

  ac.openCurrentDatabase(mdb_name)

为：

  set ac = new access.application
  ac.NewCurrentDatabase (mdb_name)

  Set db = ac.CurrentDb

这将创建一个.mdb文件，它将包含3个名为MSysDb，SummaryInfo和UserDefined的文档。

您的代码帮助我解决了我正在处理的问题，希望这可以帮助您。

Answer 2

编辑重新评论

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

以下是Less Than Dot的一些示例代码，您可以在其中找到更多详细信息。

'---------------------------------------------------------------------------------------
' 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

如何在Access中使用VBA创建自定义属性

2 个答案: