Copying Custom Properties

Custom document properties are a great way to store unique information that is associated with a document. For instance, you may have a company-assigned document number that needs to be stored with a document. A custom property fits the bill quite nicely for such purposes.

As you add custom properties to a document, you may start wondering if there is an easy way to copy them from one document to another. Unfortunately, there is no way to do this. (In my estimation, this capability would make a fine addition to the Organizer.) You can, however, create a macro that will do the copying for you. The following macro will do just that:

Sub CopyDocProps()
    Dim dSource As Document
    Dim dTarget As Document
    Dim dp As Object
    Dim J As Long
    Dim sMsg As String
    Dim sTitle As String
    Dim iResponse As vbMsgBoxResult

    sTitle = "Copy Custom Properties"
    If Documents.Count <> 2 Then
        sMsg = "Exactly two documents (source and target) must be open."
        MsgBox sMsg,,sTitle
        Exit Sub
    End If

    sMsg = "Is the source document currently active?"
    iResponse = MsgBox(sMsg,vbYesNoCancel,sTitle)

    Select Case iResponse
        Case vbCancel
            Exit Sub
        Case vbYes
            Set dSource = ActiveDocument
            If dSource Is Documents(1) Then
                Set dTarget = Documents(2)
            Else
                Set dTarget = Documents(1)
            End If
        Case vbNo
            Set dTarget = ActiveDocument
            If dTarget Is Documents(1) Then
                Set dSource = Documents(2)
            Else
                Set dSource = Documents(1)
            End If
    End Select

    If dSource.CustomDocumentProperties.Count = 0 Then
        sMsg = "There are no custom properties in the source document."
        MsgBox sMsg,,sTitle
        Exit Sub
    End If

    For J = 1 To dSource.CustomDocumentProperties.Count
        Set dp = dSource.CustomDocumentProperties(J)

        If Not CheckProp(dTarget, dp.Name) Then
            If dp.LinkToContent Then
                dTarget.CustomDocumentProperties.Add _
                  Name:=dp.Name, _
                  LinkToContent:=True, _
                  Value:=dp.Value, _
                  Type:=dp.Type, _
                  LinkSource:=dp.LinkSource
            Else
                dTarget.CustomDocumentProperties.Add _
                  Name:=dp.Name, _
                  LinkToContent:=False, _
                  Value:=dp.Value, _
                  Type:=dp.Type
            End If
        Else
            ' Update property
            With dTarget.CustomDocumentProperties(dp.Name)
                ' If link status differs, delete and recreate
                If (.LinkToContent <> dp.LinkToContent) _
                  Or (.Type <> dp.Type) Then
                    .Delete
                    If dp.LinkToContent Then
                        dTarget.CustomDocumentProperties.Add _
                          Name:=dp.Name, _
                          LinkToContent:=True, _
                          Value:=dp.Value, _
                          Type:=dp.Type, _
                          LinkSource:=dp.LinkSource
                    Else
                        dTarget.CustomDocumentProperties.Add _
                          Name:=dp.Name, _
                          LinkToContent:=False, _
                          Value:=dp.Value, _
                          Type:=dp.Type
                    End If
                Else
                    ' Same link state and type
                    ' Update value and source if needed
                    .Value = dp.Value
                    If dp.LinkToContent Then
                        If .LinkSource <> dp.LinkSource Then
                            .LinkSource = dp.LinkSource
                        End If
                    End If
                End If
            End With
        End If
    Next J

    sMsg = "Custom properties have been copied or updated."
    MsgBox sMsg,,sTitle
End Sub

Private Function CheckProp(d As Document, sName As String) As Boolean
    Dim p As Object

    On Error Resume Next
    Err.Clear
    Set p = d.CustomDocumentProperties(sName)
    CheckProp = (Err.Number = 0)
    On Error GoTo 0
End Function

The macro will copy custom properties from the source document to the target document. If the target document has a custom property with the same name as one in the source, then the one in the target document is updated to match the one in the source. The CheckProp function is used to determine if the property name already exists in the target document.

In order to use the macro, make sure that you have only the source and target documents open. When the macro is finished, you will need to save the target document.

WordTips is your source for cost-effective Microsoft Word training. (Microsoft Word is the most popular word processing software in the world.) This tip (11671) applies to Microsoft Word 2007, 2010, 2013, 2016, 2019, 2021, 2024, and Word in Microsoft 365. You can find a version of this tip for the older menu interface of Word here: Copying Custom Properties.