检查是否设置了 BuiltInDocumentProperty 没有错误捕获

Question

任务： 我的目标是检查是否在 Excel 工作簿的 BuiltInDocumentProperties 集合中设置了值。

放大备注： 我知道某些文档属性项永远不会在 Excel 中显示值，因为它们 属于 ms word 或 ppt 应用程序（例如 item 15 'Number of words'，item 25 'Slides' ...）。 另一方面，有些属性在第一次使用时只有偶尔的值：

• 第 10 项：“上次打印时间”
• 第 12 项：“上次保存时间”

当然可以通过错误捕获来做到这一点：

带有错误捕获的示例代码：

Sub test_showDocPropValue()
' Name of built in doc prog
  Dim propName As String
' a) Choose builtin doc prop disposing about a set value, such as 'Author', 'Category', ...
'    propName = "Category"
' b) Choose builtin doc prop of another ms application
'    propName = "Number of pages"

' c) Choose doc prop with occasionally set values
  propName = "Last print time"

' Show result
  MsgBox propName & " = " & showDocPropValue(propName), vbInformation, "BuiltInDocumentProperties"
End Sub

Function showDocPropValue(ByVal propName As String) As Variant
  Dim prop As Object
  Dim ret
' Built in Doc Props collection
  Set prop = ThisWorkbook.BuiltinDocumentProperties
' Error trapping
  On Error Resume Next
  ret = prop(propName).Value
  If Err.Number <> 0 Then
     ret = "(No value set)"
     Debug.Print Err.Number & ": " & Err.Description
  End If
' Return
  showDocPropValue = ret
End Function

我的问题： 出于主要原因，我想知道是否有一种简单的方法来获取 builtinDocumentProperties 值以避免错误捕获

附加提示 只是为了通过在 CUSTOM doc props 中显示没有错误捕获的方法来完成主题，您可以使用以下代码轻松检查此类项目的存在：

Private Function bCDPExists(sCDPName As String) As Boolean
' Purp.: return True|False if custom document property name exists
' Meth.: loop thru CustomDocumentProperties and check for existing sCDPName parameter 
' Site:  <http://stackoverflow.com/questions/23917977/alternatives-to-public-variables-in-vba/23918236#23918236>
' cf:    <https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other/using-customdocumentproperties-with-vba/91ef15eb-b089-4c9b-a8a7-1685d073fb9f>
Dim cdp As Variant      ' element of CustomDocumentProperties Collection
Dim boo As Boolean      ' boolean value showing element exists
For Each cdp In ThisWorkbook.CustomDocumentProperties
    If LCase(cdp.Name) = LCase(sCDPName) Then
       boo = True      ' heureka
       Exit For        ' exit loop
    End If
Next
bCDPExists= boo          ' return value to function
End Function

Answer 1

我认为没有一种简单的方法可以做到这一点——这是一个Collection，它没有一个简单的方法来测试一个项目的存在（而不是Dictionary.Exists方法，或对数组使用Match 函数等）。除了错误捕获（IMO 看起来非常简单）之外，您基本上可以对集合的项目使用蛮力迭代，检查 .Name 属性是否等效。

这是一种类似于CustomDocumentProperties 的方法，可在需要时避免错误处理（尽管我认为该方法没有明显错误）。修改了您的 showDocPropValue 函数并添加了一个额外的 GetDocProp 函数以串联使用。这应该适用于您的测试用例：

Function showDocPropValue(ByVal propName As String) As Variant
Dim prop As Object
Dim ret
' Get the BuiltInDocumentProperty(propName) if it exists
Set prop = GetDocProp(propName)
If prop Is Nothing Then
    ret = "(No value set)"
Else
    ret = prop(propName).Value
End If
' Return
showDocPropValue = ret
End Function

Function GetDocProp(ByVal propName$)
' returns the BuiltInDocumentProperties(propName) object if exists, else Nothing
Dim p As Object
Dim prop As Object
Set prop = ThisWorkbook.BuiltinDocumentProperties
For Each p In prop
    If p.Name = propName Then
        Set GetDocProp = p
        GoTo EarlyExit
    End If
Next
Set GetDocProp = Nothing
EarlyExit:
End Function

就我个人而言，我会改用这个版本（GetDocProp 函数中的错误处理）：

Function GetDocProp(ByVal propName$)
' returns the BuiltInDocumentProperties(propName) object if exists, else Nothing
Dim ret As Object

On Error Resume Next
Set ret = ThisWorkbook.BuiltinDocumentProperties(propName)
If Err.Number <> 0 Then Set ret = Nothing 'just to be safe...

Set GetDocProp = ret

End Function