如何在Excel的CustomDocumentProperties中添加DocumentProperty？

Question

我正在尝试将DocumentProperty添加到CustomDocumentProperties集合中。代码如下：

Sub testcustdocprop()
Dim docprops As DocumentProperties
Dim docprop As DocumentProperty

Set docprops = ThisWorkbook.CustomDocumentProperties
Set docprop = docprops.Add(Name:="test", LinkToContent:=False, Value:="xyz")

End Sub

运行此代码会产生以下错误：

Run-time error '5':
Invalid procedure call or argument

我尝试将其作为无返回值函数运行，代码如下：

.Add

docprops.Add Name:="test", LinkToContent:=False, Value:="xyz"

这给了我相同的错误。我如何添加自定义文档属性？

- sigil

---

Chip Pearson编写了一组有用的函数，可用作可下载代码来获取和设置文档属性此处。 - chuff

Answer 1

尝试使用这个例程：

Public Sub updateCustomDocumentProperty(strPropertyName As String, _
    varValue As Variant, docType As Office.MsoDocProperties)

    On Error Resume Next
    ActiveWorkbook.CustomDocumentProperties(strPropertyName).Value = varValue
    If Err.Number > 0 Then
        ActiveWorkbook.CustomDocumentProperties.Add _
            Name:=strPropertyName, _
            LinkToContent:=False, _
            Type:=docType, _
            Value:=varValue
    End If
End Sub

---

编辑：使用示例

^{五年过去了，“官方”的文档在这方面仍然混乱不堪……我想我应该添加一些使用示例：}

设置自定义属性

Sub test_setProperties()
    updateCustomDocumentProperty "my_API_Token", "AbCd1234", msoPropertyTypeString
    updateCustomDocumentProperty "my_API_Token_Expiry", #1/31/2019#, msoPropertyTypeDate
End Sub

获取自定义属性

Sub test_getProperties()
    MsgBox ActiveWorkbook.CustomDocumentProperties("my_API_Token") & vbLf _
        & ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry")
End Sub

列出所有自定义属性

Sub listCustomProps()
    Dim prop As DocumentProperty
    For Each prop In ActiveWorkbook.CustomDocumentProperties
        Debug.Print prop.Name & " = " & prop.Value & " (" & Choose(prop.Type, _
            "msoPropertyTypeNumber", "msoPropertyTypeBoolean", "msoPropertyTypeDate", _
            "msoPropertyTypeString", "msoPropertyTypeFloat") & ")"
    Next prop
End Sub

删除自定义属性

Sub deleteCustomProps()
    ActiveWorkbook.CustomDocumentProperties("my_API_Token").Delete
    ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry").Delete
End Sub

- Peter Albert

---

我明白了——我漏掉了“Type”参数。智能感知显示它是可选的，所以我假设它会默认为Variant。谢谢！ - sigil

不仅智能感知将其显示为可选项，它也被文档记录为可选项。结果表明它并非可选项。有时会发生这种情况。 - GSerg

这种方法很有效，但有一个限制：如果已经存在自定义属性并且您尝试分配不同的MsoDocProperties数据类型（例如，将具有类型msoPropertyTypeString的字符串值更改为具有类型msoPropertyTypeNumber的数字），则会出现错误，除非您首先删除自定义文档属性。我使用修改后的版本，检查是否存在自定义属性，如果存在，则在添加新值之前将其删除。 - ChrisB

仍然被记录为可选项：https://learn.microsoft.com/zh-cn/office/vba/api/office.documentproperties.add - Uli Gerhardt

Answer 2

我想我应该扩展一下2013年的上述答案，使其无需传递docType参数：

Private Function getMsoDocProperty(v As Variant) As Integer
    'VB TYPES:
        'vbEmpty                0       Empty (uninitialized)
        'vbNull                 1       Null (no valid data)
        'vbInteger              2       Integer
        'vbLong                 3       Long integer
        'vbSingle               4       Single-precision floating-point number
        'vbDouble               5       Double-precision floating-point number
        'vbCurrency             6       Currency value
        'vbDate                 7       Date value
        'vbString               8       String
        'vbObject               9       Object
        'vbError                10      Error value
        'vbBoolean              11      Boolean value
        'vbVariant              12      Variant (used only with arrays of variants)
        'vbDataObject           13      A data access object
        'vbDecimal              14      Decimal value
        'vbByte                 17      Byte value
        'vbUserDefinedType      36      Variants that contain user-defined types
        'vbArray                8192    Array
    
    'OFFICE.MSODOCPROPERTIES.TYPES
        'msoPropertyTypeNumber  1       Integer value.
        'msoPropertyTypeBoolean 2       Boolean value.
        'msoPropertyTypeDate    3       Date value.
        'msoPropertyTypeString  4       String value.
        'msoPropertyTypeFloat   5       Floating point value.

    Select Case VarType(v)
        Case vbInteger, vbLong
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeNumber
        Case vbBoolean
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeBoolean
        Case vbDate
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeDate
        Case vbString, vbByte
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeString
        Case vbSingle, vbDouble, vbCurrency,vbDecimal
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeFloat
        Case Else
            getMsoDocProperty = 0
    End Select
End Function

Public Sub subUpdateCustomDocumentProperty(ByVal doc as object, ByVal strPropertyName As String, _
    ByVal varValue As Variant, Optional ByVal docType As Office.MsoDocProperties = 0)
    
    If docType = 0 Then docType = getMsoDocProperty(varValue)
    If docType = 0 Then
        MsgBox "An error occurred in ""subUpdateCustomDocumentProperty"" routine", vbCritical
        Exit Sub
    End If
    
    On Error Resume Next
    doc.CustomDocumentProperties(strPropertyName).Value _
        = varValue
    If Err.Number > 0 Then
        doc.CustomDocumentProperties.Add _
            Name:=strPropertyName, _
            LinkToContent:=False, _
            Type:=docType, _
            Value:=varValue
    End If
End Sub

- Sancarn