Migrating Mail Merge Fields to Content Controls

Edit: Fixed up the unnecessary line breaks that appeared post-publish. 

There are many of you out there who have used mail merge to get data into Word documents in the past (and it continues to be a great way to create mailings), but one of the questions we've been asked a few times already by customers is how to take templates with mail merge fields and convert them into content controls (so you can create templates leveraging the XML support that I've been blogging about).

Thanks to a co-worker here at Microsoft (Thanks Lethanial!), we've developed some simple VBA code that does this conversion for you – enjoy!

Private Sub Document_Open()

    If (MsgBox("Convert Mail Merge fields to Content Controls?", vbYesNo, "Convert Mail Merge Fields") = vbYes) Then

        ConvertMailMergeFields

    End If

End Sub

'** Traverse Mail Merge fields collection and convert each mail merge field into a content control
'** while preserving its font style and format.
Private Sub ConvertMailMergeFields()


    Dim i As Integer, Count As Integer
    Dim currentFont As Font
    Dim mergeFieldname As String
    Dim field As MailMergeField


    For Each field In ActiveDocument.MailMerge.Fields

        '** Select Mail Merge field to process.
        field.Select
        Set currentFont = Selection.Font

        '** Set name for content control.
        mergeFieldname = GetMailMergeFieldName(field.Code)
        Debug.Print ("Processing [" & mergeFieldname & "]")

        '** Remove Mail Merge field and replace it with addition of new content control.
        Selection.Cut

        '** Add new content control.
        AddContentControl mergeFieldname, currentFont
        Count = Count + 1

    Next

    Debug.Print ("Number of Mail Merge Fields converted to Content Controls: " & Count)

End Sub

'** Add new content control.
Private Sub AddContentControl(ByVal mergeFieldname As String, ByVal currentFont As Font)

    Dim newControl As ContentControl
    Dim fontStyleName As String

    Set newControl = ActiveDocument.ContentControls.Add(wdContentControlText)

    '** The Title property only allows for 64 characters.
    '** If name is longer, we will put the rest in the Tag property.
    If (Len(mergeFieldname) < 64) Then

        newControl.Title = mergeFieldname
        newControl.Tag = "" 

    Else

        newControl.Title = Mid(mergeFieldname, 1, 64)
        newControl.Tag = Mid(mergeFieldname, 65, Len(mergeFieldname) - 64)

    End If

    newControl.SetPlaceholderText , , "Click to add."

    '** Set font for content control.
    fontStyleName = GetFontStyleName(currentFont)
    SetFontStyle newControl, fontStyleName, currentFont

    '** Allow carriage return.
    newControl.MultiLine = True

End Sub

'** Quick and dirty way to check to see if the given font style exist; if it does not, create it.
Private Sub SetFontStyle(ByRef newControl As ContentControl, ByVal fontStyleName As String, ByVal currentFont As Font)

    On Error GoTo Error_FontStyleDoesNotExist


    newControl.DefaultTextStyle = fontStyleName

    Exit Sub

Error_FontStyleDoesNotExist:

    AddNewFontStyle fontStyleName, currentFont
    newControl.DefaultTextStyle = fontStyleName

End Sub

Private Sub AddNewFontStyle(ByVal newFontStyleName As String, ByVal currentFont As Font)

    Dim fontStyle As Style

    Set fontStyle = ActiveDocument.Styles.Add(newFontStyleName)

    With currentFont

        fontStyle.Font.Name = .Name
        fontStyle.Font.Size = .Size
        fontStyle.Font.Bold = .Bold
        fontStyle.Font.Italic = .Italic

    End With

End Sub

Private Function GetFontStyleName(ByVal currentFont As Font) As String

    Dim fontStyleName As String

    With currentFont

        fontStyleName = .Name
        fontStyleName = fontStyleName & .Size
        fontStyleName = fontStyleName & .Bold
        fontStyleName = fontStyleName & .Italic

    End With

    '** Return result.
    GetFontStyleName = fontStyleName

End Function


Private Function GetMailMergeFieldName(ByVal fieldCode As String) As String

    Dim mergeFieldname As String: mergeFieldname = ""

    '** Name of Mail merge field: MERGEFIELD MailMergeFieldName \* MERGEFORMAT
    mergeFieldname = Replace(fieldCode, "MERGEFIELD", "")
    mergeFieldname = Replace(mergeFieldname, "\* MERGEFORMAT", "")
    mergeFieldname = Trim(mergeFieldname)

    '** Return result.
    GetMailMergeFieldName = mergeFieldname

End Function

- Tristan