如何在Access中使用VBA創建自定義屬性

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 

此代碼在l中拋出3265（在此集合中找不到項目）錯誤INE閱讀

set doc = cnt.Documents!UserDefined 

因爲（我認爲）的mdb是新建的，且尚未包含在用戶定義cnt.Documents成員。這將起作用，如果我已經手動添加了這樣一個屬性，也就是通過打開帶有訪問權的mdb文件，然後進入菜單File-> Database Properties，然後進入自定義選項卡。

Answer 1

問題是您正在使用createdatabase來創建數據庫文件。以這種方式創建MDB文件只會創建MSysDB文檔對象。

要在創建數據庫時嘗試執行並能夠在文檔！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使用和用戶自定義。

你的代碼幫助我解決了我正在處理的問題，希望這可以幫助你。

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