Word 2007 VBA Macro to Assemble a Manual from Chapters

The following VBA macro allows you to scan a directory for subdirectories and add INCLUDETEXT fields with additional bookmarks to create a master document which can be used to create several different versions of the same content. It will also create stubs for each chapter, based on the admin types.

This is very helpful for manuals.

This macro was used with a master docm file which was supported by a directory called Chapters. The Chapters directory had a numerically named subdirectory for each chapter, and within each chapter there were documents for all the admin types, as well as a Common.docm file which included text for all admin types. The content control is in the admin type file, which can be empty to omit the chapter from the manual, a single INCLUDETEXT of Common.docm to just display the common text, or any other appropriate content.


  • 1

    • Common.docm
    • System.docx
    • Application.docx
    • Editor.docx
    • Guest.docx
  • 2

    • Common.docm
    • System.docx
    • Application.docx
    • Editor.docx
    • Guest.docx

The document needs two fields, AdminType and BaseDir. AdminType must be one of those listed in the AdminTypes array, BaseDir must be set to the base directory for the document. I used ASK fields, but a SET should be fine as well.

The document also needs two bookmarks, “ChapterBlockStart” and “ChapterBlockEnd", which indicate where the chapter includes are to be placed.

Chapter numbering is managed with a SEQ field in the master document. Each chapter’s common.docm has a SEQ reference which increments the chapter number. This ensures the chapter numbers are contiguous even if some chapters are omitted for a specific admin type.

Option Base 1
Option Explicit
Global AdminTypes

Sub Init()
'   Initialize AdminTypes array
    AdminTypes = Array("System", "Application", "Editor", "Guest")
End Sub

Sub FindChapters()


Dim CleanStart, CleanEnd, CleanRange
Dim I, L, T, D, Done
Dim Range
Dim BaseDir, ChapterDir, RootDir
Dim AdminTypeRange, BaseDirRange

' This code removes the old chapters, so you can run the macro on a document to update it if you have
' added more chapters.

CleanStart = ActiveDocument.Bookmarks("ChapterBlockStart").Range.Start
CleanEnd = ActiveDocument.Bookmarks("ChapterBlockEnd").Range.End
Set CleanRange = ActiveDocument.Range(Start:=CleanStart, End:=CleanEnd)
CleanRange.MoveStart wdCharacter, 1
CleanRange.MoveEnd wdCharacter, -1
If CleanRange.Characters.Count > 1 Then CleanRange.Cut

' Position the range at the start of the ChapterBlock
Set Range = ActiveDocument.Bookmarks("ChapterBlockStart").Range

' Get the value of BaseDir.  This is probably terribly inefficient.
I = 1
L = ActiveDocument.Fields.Count()
For I = 1 To L
    T = ActiveDocument.Fields.Item(I).Code.Text
    If (InStr(1, T, "BaseDir", vbTextCompare) <> 0) Then
        BaseDir = ActiveDocument.Fields.Item(I).Result()
    End If

' Loop through all the chapters.  The directory is named 'Chapters'
D = FileSystem.CurDir()
RootDir = BaseDir + "\Chapters\"
I = 1
' This is actually an infinite loop.  It uses On Error to terminate when it runs out of chapters
Done = False
While Not Done
    ' Name the chapter directory
    ChapterDir = RootDir + Trim(Str$(I))
    ' If you can't change into the chapter directory, you're done
    On Error GoTo AllDone
    ' Change into the chapter directory
    FileSystem.ChDir (ChapterDir)
    ' This ensures there is a file for all the admin types for that chapter
    CreateChapter (Trim(Str$(I)))
    ' Each chapter is in a section, on a new page
    Range.Sections.Add Range, wdSectionNewPage

    ' Create the INCLUDETEXT tag
    Range.Fields.Add Range, wdFieldIncludeText, Chr(34) + "BaseDir\\Chapters\\" + Trim(Str$(I)) + "\\AdminType.docx" + Chr(34)

    ' Add in the BaseDir and AdminType fields, so the document is portable and adapts to the admin type
    Set BaseDirRange = Range.Duplicate
    BaseDirRange.Find.MatchCase = True
    BaseDirRange.Find.Text = "BaseDir"
    BaseDirRange.Fields.Add BaseDirRange, wdFieldEmpty, , False
    Set AdminTypeRange = Range.Duplicate
    AdminTypeRange.Find.Text = "AdminType"
    AdminTypeRange.Fields.Add AdminTypeRange, wdFieldEmpty, , False
    AdminTypeRange.Collapse wdCollapseEnd

    ' Advance the range pointer
    Range.MoveEnd wdSection, 1
    Range.Collapse wdCollapseEnd

    ' Increment the chapter counter
    I = I + 1
AllDone: MsgBox "Found " + Str$(I - 1) + " Chapters"

' Update the fields

End Sub

Sub CreateChapter(C As String)
    Dim I, L
    Dim NewDoc, NewRange, BaseDirRange
    Dim FileName
    I = LBound(AdminTypes)
    L = UBound(AdminTypes)
    ' Loop through all the admin types
    For I = 1 To L
        FileName = AdminTypes(I) + ".docx"

        ' If the document doesn't exist
        If (Dir(FileName) = "") Then
            ' Create the document
            Set NewDoc = Documents.Add
            Set NewRange = NewDoc.Range
            ' Add an INCLUDETEXT field to include Common.docm which would be the chapter content common
            ' to all admin types.
            NewRange.Fields.Add NewRange, wdFieldIncludeText, Chr(34) + "BaseDir\\Chapters\\" + Trim(Str$(C)) + "\\Common.docm" + Chr(34)
            Set BaseDirRange = NewRange.Duplicate
            BaseDirRange.Find.MatchCase = True
            BaseDirRange.Find.Text = "BaseDir"
            BaseDirRange.Fields.Add BaseDirRange, wdFieldEmpty, , False
            NewRange.MoveEnd wdSection, 1
            NewRange.Collapse wdCollapseEnd

            ' Save the new file, named by the role and close the window
            NewDoc.SaveAs FileName
        End If
End Sub 

Sincere thanks to the referenced link. If you have questions about the field insertion, you will find the answers there.

For the table of contents, I extended the ChapterBlockStart and used it to indicate the content to include. The footer included the page number with a chapter prefix.