Data driven document generation with Word 2007

Erika wrote a couple posts worth a look regarding Data driven document generation.

Data-driven document generation with Word 2007 and the Office XML File Formats: Part 1

Data-driven document generation with Word 2007 and the Office XML File Formats: Part 2

Also If you wanted to take a Mail Merge word doc and port it over to XML

Migrating Mail Merge Fields to Content Controls ( I republished the code so that its legible)


Private Sub Document_Open()

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


    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.
        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.

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


    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 = "" 


        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


    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
Comments [0]