列出 BuiltInDocumentProperties 会导致错误

Question

我正在尝试列出所有内置和自定义文档属性。我使用以下代码执行此操作：

Option Explicit
    
Sub CheckDocumentCustomProperties()
Dim i As Integer
Dim Custom As Object
Dim Default As Object
Set Custom = ActiveDocument.CustomDocumentProperties
Set Default = ActiveDocument.BuiltInDocumentProperties
       
'    Debug.Print "CustomDocumentProperties:"; vbNewLine
'
'    For i = 1 To Custom.Count
'             Debug.Print Custom.Item(i).Name + ": " + Custom.Item(i).Value
'             On Error Resume Next
'    Next
    
Debug.Print vbNewLine; "BuiltinDocumentProperties:"; vbNewLine
    
For i = 1 To Default.Count
    Debug.Print Default.Item(i).Name + " " + Default.Item(i).Value
Next
      
End Sub

我的问题是运行弹出时间错误 13。因此，我注释掉了自定义属性，因为我认为那里存在问题。但是，我仍然收到错误消息。
因此，我运行显示一次代码并进行以下修改，注释掉值：

For i = 1 To Default.Count
    Debug.Print Default.Item(i).Name '+ " " + Default.Item(i).Value

结果如下：

BuiltinDocumentProperties:
    
Title Standard_Vorlage
Subject 
Author IMS Team
Keywords 
Comments 
Template Normal.dotm
Last author Hodzic Adis
Revision number 3
Application name Microsoft Office Word
    
BuiltinDocumentProperties:
    
Title
Subject
Author
Keywords
Comments
Template
Last author
Revision number
Application name
Last print date
Creation date
Last save time
Total editing time
Number of pages
Number of words
Number of characters
Security
Category
Format
Manager
Company
Number of bytes
Number of lines
Number of paragraphs
Number of slides
Number of notes
Number of hidden Slides
Number of multimedia clips
Hyperlink base
Number of characters (with spaces)
Content type
Content status
Language
Document version

通过比较，我注意到 Last print date 导致了第一个错误。不幸的是，我也不知道如何解决这个问题或者为什么会出现这个问题...

我也尝试过将我的代码转换成字符串，但这不是解决方案：

Debug.Print CStr(Default.Item(i).Name + " " + Default.Item(i).Value)

Answer 1

您正在尝试访问尚未设置的属性的值。

根据文档：

If the container application doesn't define a value for one of the built-in document properties, reading the Value property for that document property causes an error.

DocumentProperty.Value property

因此您需要在尝试读取之前检查该值是否为空。

With Default.Item(i)
    If Not IsNull(.Value) Then Debug.Print .Value Else Debug.Print "Empty"
End With

编辑：

事实证明，它比检查 null 要多一些，但这可以通过辅助方法轻松克服以读取值。

Private Function ReadValue(prop As Object) As String
    
    Dim retValue As String
    
    On Error Resume Next
    retValue = prop.Value
    If Err.Number <> 0 Then retValue = "Empty"
    
    ReadValue = retValue
End Function

然后调用方法获取它的值（如果有的话）。

Dim prop As Object

For Each prop In ActiveDocument.BuiltinDocumentProperties
    Debug.Print prop.Name & ": " & ReadValue(prop)
Next

'Last print date: Empty

Answer 2

文档（评论中的link）说在尚未设置的 DocumentProperty 上调用 Value() 会导致错误。在调用 Value() 之前似乎没有办法对此进行测试，因此您必须自己处理错误。例如，如果您尚未打印文档，则不会有上次打印日期。

Option Explicit
Sub CheckDocumentCustomProperties()

    Dim Default As Object
    Set Default = ActiveDocument.BuiltInDocumentProperties
        
    Debug.Print vbNewLine; "BuiltinDocumentProperties:"; vbNewLine

    Dim vProp As Variant
    Dim op As DocumentProperty

    On Error GoTo BadValue
    Dim strDbg As String

    For Each op In Default
        strDbg =  op.Name & "= "
        vProp = op.Value
        Debug.Print strDbg & vProp
    Next op
      
    Exit Sub

BadValue:
    vProp = "!Missing Value!"
    Resume Next
 
End Sub

Answer 3

请参阅 Astrid Zeelenberg 关于此的文章 Word MVP Page: How to use a single VBA procedure to read or write both custom and built-in Document Properties

When you work with Document Properties in code, most people end up with two functions >or subroutines, one to write built-in Document Properties and one for custom Document >Properties; because in each case the object used to refer to the Document Properties is >different – you have to use the CustomDocumentProperties and BuiltinDocumentProperties >collection as appropriate. But this can be very inconvenient. Writing Document Properties

However, you can write a procedure which checks whether the property you want to write the value for is custom or built-in, and then uses the appropriate collection. (Note: If you are not familiar with calling subroutines with arguments, see: How to cut out repetition and write much less code, by using subroutines and functions that take arguments).

This is how to do it:

Public Sub WriteProp(sPropName As String, sValue As String, _
      Optional lType As Long = msoPropertyTypeString)

'In the above declaration, "Optional lType As Long = msoPropertyTypeString" means
'that if the Document Property's Type is Text, we don't need to include the lType argument
'when we call the procedure; but if it's any other Prpperty Type (e.g. date) then we do

Dim bCustom As Boolean

  On Error GoTo ErrHandlerWriteProp

  'Try to write the value sValue to the custom documentproperties
  'If the customdocumentproperty does not exists, an error will occur
  'and the code in the errorhandler will run
  ActiveDocument.BuiltInDocumentProperties(sPropName).Value = sValue
  'Quit this routine
  Exit Sub

Proceed:
  'We know now that the property is not a builtin documentproperty,
  'but a custom documentproperty, so bCustom = True
  bCustom = True

Custom:
  'Try to set the value for the customproperty sPropName to sValue
  'An error will occur if the documentproperty doesn't exist yet
  'and the code in the errorhandler will take over
  ActiveDocument.CustomDocumentProperties(sPropName).Value = sValue
  Exit Sub

AddProp:
  'We came here from the errorhandler, so know we know that
  'property sPropName is not a built-in property and that there's
  'no custom property with this name
  'Add it
  On Error Resume Next
  ActiveDocument.CustomDocumentProperties.Add Name:=sPropName, _
    LinkToContent:=False, Type:=lType, Value:=sValue

  If Err Then
    'If we still get an error, the value isn't valid for the Property Type
    'e,g an invalid date was used
    Debug.Print "The Property " & Chr(34) & _
     sPropName & Chr(34) & " couldn't be written, because " & _
     Chr(34) & sValue & Chr(34) & _
     " is not a valid value for the property type"
  End If

  Exit Sub

ErrHandlerWriteProp:
  Select Case Err
    Case Else
   'Clear the error
   Err.Clear
   'bCustom is a boolean variable, if the code jumps to this
   'errorhandler for the first time, the value for bCustom is False
   If Not bCustom Then
     'Continue with the code after the label Proceed
     Resume Proceed
   Else
     'The errorhandler was executed before because the value for
     'the variable bCustom is True, therefor we know that the
     'customdocumentproperty did not exist yet, jump to AddProp,
     'where the property will be made
     Resume AddProp
   End If
  End Select

End Sub

We could call the above procedure like this:

Sub Test()
  'Author is a built-in property
  Call WriteProp(sPropName:="Author", sValue:="William Shakespeare")

  'Date Updated is a custom document property
  Call WriteProp(sPropName:="Date Updated", sValue:="11 Mar 2001", _
    lType:=msoPropertyTypeDate)
End Sub

Reading Document Properties

The same principle can be used when reading Document Properties:

Function ReadProp(sPropName As String) As Variant

Dim bCustom As Boolean
Dim sValue As String

  On Error GoTo ErrHandlerReadProp
  'Try the built-in properties first
  'An error will occur if the property doesn't exist
  sValue = ActiveDocument.BuiltInDocumentProperties(sPropName).Value
  ReadProp = sValue
  Exit Function

ContinueCustom:
  bCustom = True

Custom:
  sValue = ActiveDocument.CustomDocumentProperties(sPropName).Value
  ReadProp = sValue
  Exit Function

ErrHandlerReadProp:
  Err.Clear
  'The boolean bCustom has the value False, if this is the first
  'time that the errorhandler is runned
  If Not bCustom Then
    'Continue to see if the property is a custom documentproperty
    Resume ContinueCustom
  Else
    'The property wasn't found, return an empty string
    ReadProp = ""
    Exit Function
  End If

End Function

We could call the function like this:

Sub Test()

Dim PropVal As String
 
  PropVal = ReadProp("Author")
  Debug.Print PropVal

  PropVal = ReadProp("Date Completed")
  Debug.Print PropVal

End Sub

据我所知，这段代码虽然很旧，但仍然有效。我用过

Answer 4

感谢您的 inpu 社区！
这是我使用的代码，它实际上是@DS_London.
的解决方案最后我确实有一些要指出的...

Option Explicit

Sub MyWorkbookProperties()

Dim i As Integer
Dim Custom As Object
Set Custom = ActiveWorkbook.CustomDocumentProperties
Dim Default As DocumentProperties
Set Default = ActiveWorkbook.BuiltinDocumentProperties

Dim Name As Variant
Dim Value As Variant
Dim cp As CustomProperty
Dim dp As DocumentProperty


On Error GoTo BadValue

Debug.Print vbNewLine; "Built in Document Properties"; vbNewLine

'For Each dp In Default
    'Name = dp.Name & ": "
    'Value = dp.Value
    'Debug.Print Name + Value
'Next

For i = 1 To Default.Count
    Name = Default.Item(i).Name & ": "
    Value = Default.Item(i).Value
    Debug.Print Name + Value
Next


Debug.Print vbNewLine; "Custom Document Properties"; vbNewLine

'For Each cp In Custom
     'Name = cp.Name & ": "
     'Value = cp.Value
     'Debug.Print Name + Value
'Next

For i = 1 To Custom.Count
    Name = Custom.Item(i).Name & ": "
    Value = Custom.Item(i).Value
    Debug.Print Name + Value
Next

BadValue:
Value = "Bad Value"
Resume Next
             
    
End Sub

在我的问题中，我确实提到了 CustomProperties。如果您不知道以下两个循环是不同的。我确实使用了当然没有被注释掉的

  'For Each cp In Custom
        'Name = cp.Name & ": "
        'Value = cp.Value
        'Debug.Print Name + Value
  'Next
    
  For i = 1 To Custom.Count
        Name = Custom.Item(i).Name & ": "
        Value = Custom.Item(i).Value
        Debug.Print Name + Value
  Next

由于我仍然缺少一些值，所以我不得不添加 ContentTypeProperties。 Codewise 我添加了以下内容：

Debug.Print vbNewLine; "Content Type Properties"; vbNewLine

Dim Content As Object
Set Content = ActiveWorkbook.ContentTypeProperties

For i = 1 To Content.Count
    Name = Content.Item(i).Name & ": "
    Value = Content.Item(i).Value
    Debug.Print Name + Value
Next

列出 BuiltInDocumentProperties 会导致错误

Listing BuiltInDocumentProperties leads to error

vba

ms-word