excel - 检查BuiltInDocumentProperty是否已设置且没有错误捕获

Question

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

放大评论:我知道某些文档属性项在 Excel 中永远不会显示值，因为它们属于 ms word 或 ppt 应用程序(例如第 15 项“单词数”、第 25 项“幻灯片”...)。另一方面，某些属性在首次使用时仅具有偶尔的值:

• 第 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值以避免错误捕获

附加提示只是为了通过在自定义文档 Prop 中显示没有错误捕获的方法来完成主题，您可以使用以下代码轻松检查此类项目是否存在:

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 函数等)。除了错误捕获(在我看来这似乎非常简单)之外，您基本上只能对集合的项目使用强力迭代，检查 .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