Microsoft Office 2007 Standard Migrating Mail Merg

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 IfEnd 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,Office 2007 Professional Key, 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(wdContentContro lText)
'** The Title property only allows for 64 characters.
'** If name is longer,Windows 7 Home Premium, 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,Office Pro 2007, Len(mergeFieldname) - 64) End If newControl.SetPlaceholderText , , "Click to add." '** Set font for content control.
fontStyleName = GetFontStyleName(currentFont)
SetFontStyle newControl,Office 2010 Pro Plus, fontStyleName, currentFont '** Allow carriage return.
newControl.MultiLine = TrueEnd 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,Microsoft Office 2007 Standard, ByVal fontStyleName As String, ByVal currentFont As Font)
On Error GoTo Error_FontStyleDoesNotExist
newControl.DefaultTextStyle = fontStyleName
Exit SubError_FontStyleDoesNotExist: AddNewFontStyle fontStyleName, currentFont
newControl.DefaultTextStyle = fontStyleNameEnd SubPrivate 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 WithEnd SubPrivate 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 = mergeFieldnameEnd Function

- Tristan
<div