Изменение свойства пользовательского документа в 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.

Я также изменил обе свои функции так, чтобы они возвращали значение вызывающей процедуре и поэтому могут использоваться в булевых операторах для оценки того, были ли присвоены свойства без ошибок. Ваши предыдущие функции всегда возвращались 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