Change a custom document property within Word

Question

I'm trying to change the properties of a document before I save it, but none of my properties below are being added.

How can I fix this problem? Thanks.

'**
 ' 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

Solution

I don't see anything obvious but I don't like your On Error Resume Next. It's almost always better to trap that error, and you can do that with a function that checks whether a property exists, rather than trying to assign to a non-existent property and handle the err.Number.

I have also modified both of your functions so that they return a value to the calling procedure and therefore can be used in boolean statements to evaluate whether the properties were assigned without error. Your previous functions were always returning True for some reason...

This seems to work for me and persists beyond save/close of the document.

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

Comments

[David Zemens]

How are you calling this procedure? Have you done normal debugging (i.e., put a MsgBox prompt in the procedure to ensure it's being called as expected)?

[David Gard]

Yep, the procedure is being called. I've not included all of my code as it's really not relevant, but rest assured I have checked that I am including the above. Thanks.

[David Zemens]

How are you calling this procedure? (Manually or event-driven?) I'm fairly certain the rest -- or at least some part of your other code -- is relevant; especially if that code is responsible for saving and/or closing the document in question, it would be easy to make a mistake and close with SaveChanges:=False, etc.

[David Zemens]

Also, is there any reason you're doing these as Function rather than Sub? (I wouldn't expect it to make a difference, just curious...)

[David Gard]

It's manually driven, and the macro doesn't actually close or save the document. It copies a section of text from the active document, creates a new document (tempDoc), pastes the copied text and then (in theory!) sets the document properties. From there the user can edit and save as required, but the properties are not being set at all.

[David Gard]

And the function thing is just habit. I usually add some error handling and return false if the work carried out by the function fails, but I haven't gotten around to that yet.

[David Gard]

Yep, that did the trick. The custom properties are now being added, thanks for the help. And just in case you are wondering, they will not be Title, Subject and Keywords (whcih are default available properties), that was just for example purposes as the actual ones I will use are private (boring corporate stuff!). Thanks.

[ZAT]

@DavidGard if your purpose served, please mark as answer to close it.