This is a macro that reads a (Microsoft) Word 2007 document which uses INCLUDETEXT fields to draw in content from other documents and exports the content as a PDF, including a table of contents and index.

There are three administrator types or roles - System, Partner, and Limited. For each chapter, an INCLUDETEXT field includes the content for that role, for example:

{INCLUDETEXT "{BaseDir}//Overview//{AdminRole}.docx"}

The document for each role has the appropriate content. In most cases, the directory has a Common.docx file that has the text for all roles, and those authorized to view it include the file like so:

{INCLUDETEXT "{BaseDir}//Overview//Common.docx"}

Unauthorized users would have an empty .docx file, or one with a limited version of content.

The way the macro works is to first extract the value of BaseDir, which allows an absolute path to be used, but modified without updating all the files. Relative paths just didn’t work well.

The document also uses some bookmarks, which the macro uses to reference different sections. One bookmark includes all the content from both the chapters and appendices. The chapters are enclosed in a bookmark called ‘Chapter’, and the appendices are enclosed in a bookmark called ‘Appendix’. These bookmarks are used to create the footers, since the chapters are numeric and the appendices are alphabetic. If content for the chapter is included for the role, a section break is inserted. This ensures that the chapter and page numbers are consequetive, even if chapters are omitted.

Option Base 1
Option Explicit
Global AdminTypes

Sub Init()
    AdminTypes = Array("System", "Partner", "Limited")
End Sub

Sub CreatePDFs()

Dim C, D, I, L, N, T, F, BaseDir, FieldCount
Dim BaseDirFieldItemIndex, AdminTypeFieldItemIndex, CurrentYearFieldItemIndex
Dim rngTemp As Range, rngField As Range
Dim fldPtr As Field
Dim J, JL, JU, arrBookmarks(2) As String
Dim Selection As Range
Dim Footer As Range
Dim S As String, LastFooterType As String

Init
I = 1
AdminTypeFieldItemIndex = 0
BaseDirFieldItemIndex = 0

FieldCount = ActiveDocument.Fields.Count()

For I = 1 To FieldCount
    T = ActiveDocument.Fields.Item(I).Code.Text
    If (InStr(1, T, "BaseDir", vbTextCompare) <> 0) Then
        BaseDirFieldItemIndex = I
    End If
    If (InStr(1, T, "AdminType", vbTextCompare) <> 0) Then
        AdminTypeFieldItemIndex = I
    End If
    If (InStr(1, T, "CurrentYear", vbTextCompare) <> 0) Then
        CurrentYearFieldItemIndex = I
    End If
    If AdminTypeFieldItemIndex <> 0 And BaseDirFieldItemIndex <> 0 And CurrentYearFieldItemIndex <> 0 Then Exit For
Next

' Set the current year for the copyright date
Set rngTemp = ActiveDocument.Fields.Item(CurrentYearFieldItemIndex).Code
rngTemp.Text = " SET CurrentYear " + Chr(34) + Str$(DatePart("yyyy", Date)) + Chr(34) + " "

' Set the base directory for INCLUDETEXT tags
ActiveDocument.Fields.Item(BaseDirFieldItemIndex).Update
D = ActiveDocument.Fields.Item(BaseDirFieldItemIndex).Result()
Set rngTemp = ActiveDocument.Fields.Item(BaseDirFieldItemIndex).Code
rngTemp.Text = " SET BaseDir " + Chr(34) + D + Chr(34) + " "
D = D + Chr(92)

' Setup the loop boundaries for the roles
I = LBound(AdminTypes)
L = UBound(AdminTypes)

' Set up the sections that will be processed
arrBookmarks(1) = "Chapter"
arrBookmarks(2) = "Appendix"
JL = LBound(arrBookmarks)
JU = UBound(arrBookmarks)
LastFooterType = ""

' Loop through all the admin types or roles
For N = I To L

    ' Set the role for this document
    Set rngTemp = ActiveDocument.Fields.Item(AdminTypeFieldItemIndex).Code
    rngTemp.Text = " SET AdminType """ + AdminTypes(N) + """ "
    ActiveDocument.Fields.Item(AdminTypeFieldItemIndex).Update
         
    ' Update all the fields for this role
    Set rngTemp = ActiveDocument.Bookmarks("ChapterBlockStart").Range
    rngTemp.Select
    rngTemp.Fields.Update
    
    ' Loop through the sections that will be processed.
    ' Each included file is checked to see if content was included
    ' Files that have content are followed by a section break, empty files are not
    For J = JL To JU
         
        Set rngTemp = ActiveDocument.Bookmarks(arrBookmarks(J)).Range
        rngTemp.Select
     
        For Each fldPtr In rngTemp.Fields
            ' Loop through all the field in this section or group of included files
            T = fldPtr.Type
            ' If this field is an INCLUDETEXT
            If (T = wdFieldIncludeText) Then
                T = Trim(fldPtr.Result())
                ' If the included text is not empty
                If (T <> "") And (Asc(T) <> 13) Then
                    Set rngField = ActiveDocument.Range
                    rngField.Find.Text = fldPtr.Code
                    ' Search the document for the tag.  This ensures included tags do not add section breaks
                    rngField.Find.Execute
                    If rngField.Find.Found Then
                        ' Select the tag
                        rngField.Select
                        ' Advance the range to the end of the field
                        rngField.MoveEnd wdCharacter, 2
                        rngField.Collapse wdCollapseEnd
                        ' Page numbering starts at 1 for all sections
                        rngField.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = 1
                        rngField.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = True
                        If LastFooterType = arrBookmarks(J) Then
                            rngField.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = True
                        Else
                           rngField.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
                            ' Create new footer
                            Set Footer = rngField.Sections(1).Footers(wdHeaderFooterPrimary).Range
                            Footer.Select
                            ' Clear any existing text
                            Footer.Delete
                            ' Set up the table
                            Footer.Tables.Add Range:=Footer, NumRows:=1, _
                                NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
                            With Footer.Tables(1)
                                .Borders.Enable = False
                                If .Style <> "Table Grid" Then
                                    .Style = "Table Grid"
                                End If
                                .ApplyStyleHeadingRows = False
                                .ApplyStyleLastRow = False
                                .ApplyStyleFirstColumn = False
                                .ApplyStyleLastColumn = False
                                .ApplyStyleRowBands = False
                                .ApplyStyleColumnBands = False
                            End With
                            ' Left column
                            Set Selection = Footer.Tables(1).Cell(1, 1).Range
                            Selection.Select
                            Selection.Collapse wdCollapseStart
                            Selection.Text = "Mobiso " + AdminTypes(N) + " Administrator's Guide"
                            ' Right column
                            Selection.Start = Footer.Tables(1).Cell(1, 2).Range.Start
                            Selection.Select
                            Selection.Collapse wdCollapseStart
                            Selection.Text = arrBookmarks(J) + " <field> - <page>"
                            Selection.Find.Text = "<field>"
                            If Selection.Find.Execute Then
                                Selection.Select
                                S = "SEQ Chapter \c"
                                If arrBookmarks(J) = "Appendix" Then
                                    S = S + " \* ALPHABETIC"
                                Else
                                    S = S + " \* ARABIC"
                                End If
                                Selection.Fields.Add Range:=Selection, Type:=wdFieldEmpty, Text:=S, PreserveFormatting:=False
                            End If
                            Selection.Find.Text = "<page>"
                            If Selection.Find.Execute Then
                                Selection.Select
                                Selection.Fields.Add Range:=Selection, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
                            End If
                            Footer.Tables(1).Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
                            LastFooterType = arrBookmarks(J)
                        End If
                        ' Insert the section break
                        rngField.InsertBreak wdSectionBreakNextPage
                    End If
                End If
            End If
        Next fldPtr
    Next J
           
    Set rngTemp = ActiveDocument.Bookmarks("Appendix").Range
    rngTemp.Select
    rngTemp.Find.Execute FindText:="^b", ReplaceWith:="", Replace:=wdReplaceOne, Forward:=False
           
    ' Update table of contents and index
    ActiveDocument.TablesOfContents.Item(1).Update
    ActiveDocument.Indexes.Item(1).Update
    
    'MsgBox "Exporting " + AdminTypes(N) + " manual to PDF (" + D + AdminTypes(N) + ".pdf)"
    ActiveDocument.ExportAsFixedFormat D + AdminTypes(N) + ".pdf", wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportAllDocument
    
    ' Remove the inserted section breaks
    For J = JL To JU
        Set rngTemp = ActiveDocument.Bookmarks(arrBookmarks(J)).Range
        rngTemp.Find.Execute FindText:="^b", ReplaceWith:="", Replace:=wdReplaceAll
    Next J
    
    ' Helpful if you want to build one PDF, then check it
    'If (MsgBox("Built " + AdminTypes(N) + " PDF", vbOKCancel, "Continue?") = vbCancel) Then Exit For
      
Next

MsgBox "Done - Updated PDFs are in " + D

End Sub

This code has good examples of the following with VBA:

• Set a FIELD tag
• Delete a section break
• Export a Word document
• Create a footer
• Create a table
• Insert a section break

This post courtesy of http://mobiso.com