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。

我还修改了两个函数，以便它们将值返回给调用过程，因此可以在布尔语句中使用它来评估属性是否被分配而没有错误。由于某种原因，您以前的函数总是返回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

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

Private Sub SetCustomDocumentProperty(Name_ As String, LinkToContent, Type_, Value)
  For Each Prop In ActiveDocument.CustomDocumentProperties
    If Prop.Name = Name_ Then
      ActiveDocument.CustomDocumentProperties(Name).Value = Value
      Exit Sub
    End If
  Next

  ActiveDocument.CustomDocumentProperties.Add _
    Name:=Name_, LinkToContent:=LinkToContent, Type:=Type_, Value:=Value
End Sub

Answer 3

正在工作。问题很简单，您必须先保存文档，然后再进行保存。

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

3 个答案: