在Word中更改自定义文档属性

Question

我在保存文档之前尝试更改其属性，但是下面的属性均未添加。

如何解决此问题？谢谢。

'**
 ' Set the required properties for this document
 '*
Function SetProperties(ByVal DocumentName As String, _
                          ByRef tempDoc As Document) As Boolean

    Call UpdateCustomDocumentProperty(tempDoc, "Title", DocumentName & ".pdf", 4)
    Call UpdateCustomDocumentProperty(tempDoc, "Subject", "New Starter Guides", 4)
    Call UpdateCustomDocumentProperty(tempDoc, "Keywords", "new starters, guide, help", 4)

    SetProperties = True

End Function

'**
 ' Update a single custom value
 '*
Function UpdateCustomDocumentProperty(ByRef doc As Document, _
                                      ByVal propertyName As String, _
                                      ByVal propertyValue As Variant, _
                                      ByVal propertyType As Office.MsoDocProperties)

    On Error Resume Next
    doc.CustomDocumentProperties(propertyName).value = propertyValue
    If Err.Number > 0 Then
        doc.CustomDocumentProperties.Add _
            Name:=propertyName, _
            LinkToContent:=False, _
            Type:=propertyType, _
            value:=propertyValue
    End If

    UpdateCustomDocumentProperty = True

End Function

Answer 1

我看不到任何明显的东西，但我不喜欢你的On Error Resume Next。捕获该错误几乎总是更好，并且可以使用检查属性是否存在的函数来做到这一点，而不是尝试分配给不存在的属性并处理err.Number。

我还修改了您的两个函数，以便它们return

到调用过程的值，因此可以在布尔语句中使用它来评估是否正确分配了属性。由于某些原因，您以前的函数总是返回True ...

这似乎对我有用，并且在文档的保存/关闭之后仍然存在。

Option Explicit
Sub setProps()
    'I use this to invoke the functions and save the document.

    If Not SetProperties("Another!", ThisDocument) Then
        MsgBox "Unable to set 1 or more of the Custom Document Properties.", vbInformation
        GoTo EarlyExit
    End If

    'Only save if there was not an error setting these
    ThisDocument.Save


    Debug.Print ThisDocument.CustomDocumentProperties(1)
    Debug.Print ThisDocument.CustomDocumentProperties(2)
    Debug.Print ThisDocument.CustomDocumentProperties(3)

EarlyExit:

End Sub


Function SetProperties(ByVal DocumentName As String, _
                          ByRef tempDoc As Document) As Boolean
'**
 ' Set the required properties for this document
 '*
    Dim ret As Boolean

    If UpdateCustomDocumentProperty(tempDoc, "Title", DocumentName & ".pdf", 4) Then
        If UpdateCustomDocumentProperty(tempDoc, "Subject", "New Starter Guides", 4) Then
            If UpdateCustomDocumentProperty(tempDoc, "Keywords", "new starters, guide, help", 4) Then
                ret = True
            End If
        Else
            ret = False
        End If
    Else
        ret = False
    End If

    SetProperties = ret


End Function


Function UpdateCustomDocumentProperty(ByRef doc As Document, _
                                      ByVal propertyName As String, _
                                      ByVal propertyValue As Variant, _
                                      ByVal propertyType As Office.MsoDocProperties)
'**
 ' Update a single custom value
 '*
    Dim ret As Boolean
    ret = False

    If PropertyExists(doc, propertyName) Then
        doc.CustomDocumentProperties(propertyName).Value = propertyValue
    Else:
        doc.CustomDocumentProperties.Add _
            name:=propertyName, _
            LinkToContent:=False, _
            Type:=propertyType, _
            Value:=propertyValue
    End If

    On Error Resume Next
    ret = (doc.CustomDocumentProperties(propertyName).Value = propertyValue)
    On Error GoTo 0

    UpdateCustomDocumentProperty = ret
End Function

Function PropertyExists(doc As Document, name As String)
'Checks whether a property exists by name
Dim i, cdp

For i = 1 To doc.CustomDocumentProperties.Count
    If doc.CustomDocumentProperties(i).name = name Then
        PropertyExists = True
        Exit Function
    End If
Next

End Function

Answer 2

对我来说，此解决方案效果很好：