Category: "Other"

Word 2007 VBA Macro to Create PDFs for a Manual

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

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

' 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
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) + """ "
    ' Update all the fields for this role
    Set rngTemp = ActiveDocument.Bookmarks("ChapterBlockStart").Range
    ' 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
        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
                    If rngField.Find.Found Then
                        ' Select the tag
                        ' 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
                           rngField.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
                            ' Create new footer
                            Set Footer = rngField.Sections(1).Footers(wdHeaderFooterPrimary).Range
                            ' Clear any existing text
                            ' 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.Collapse wdCollapseStart
                            Selection.Text = "Mobiso " + AdminTypes(N) + " Administrator's Guide"
                            ' Right column
                            Selection.Start = Footer.Tables(1).Cell(1, 2).Range.Start
                            Selection.Collapse wdCollapseStart
                            Selection.Text = arrBookmarks(J) + " <field> - <page>"
                            Selection.Find.Text = "<field>"
                            If Selection.Find.Execute Then
                                S = "SEQ Chapter \c"
                                If arrBookmarks(J) = "Appendix" Then
                                    S = S + " \* ALPHABETIC"
                                    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.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.Find.Execute FindText:="^b", ReplaceWith:="", Replace:=wdReplaceOne, Forward:=False
    ' Update table of contents and index
    '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

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

BlackBerry Web Development - SDK

BlackBerries now have a very cool widget development approach, you can build a web interface, run it through an SDK and it will create the widget or .cod file.

My goal was to learn, to see what it is, what it can do, and decide whether I can use it for some of my projects.

What is it? - I chose to use the command line version of the SDK, because I don’t use Eclipse or Visual Studio (which the SDK can plug into). I had to install some Java DK files as well, you can find references to them in the BlackBerry installation and set up documentation. I didn’t set up a path to the bbwp.exe, I used a relative path to reference it from the widget directories. Worked fine.

What can it do? - I saw the Widget SDK as a tool which would allow me to create cross-platform widgets, where a common core of code could provide key features, and device specific APIs would allow access to device stores such as the call logs, events, phone features, and audio. BlackBerry has an excellent API into those features, and I suspect it will be extended as this approach gains momentum. It’s an excellent balance of proprietary and custom features with a common access method. The two APIs I tested with audio and contact interfaces.

Can I use it? - Yes, but not yet. After I finished, I felt the greatest advantage was that it allows you to create a web application packaged as a widget. Potential issues include ensuring the widget version is updated to stay synchronized with the server, which would not be an issue if the code was delivered directly from a server. It does allow an off-line version. I had a general application in mind, and I think I would wait to see the system mature a little before building.

What I learned

  • It’s Windows based. I may be wrong, but it looks like you need a Microsoft machine for development.
  • It’s new. Everyone is still learning, and I would expect things to change.
  • It works. The process to assemble a widget with the SDK/widget packager does work without any surprises.
  • If it doesn’t work (meaning I made a mistake), it doesn’t work (meaning there aren’t any packaging or run time errors, it just doesn’t work.)
  • The command line packager process was not streamlined. My approach was the following:

    1. Use Windows Explorer to navigate to my widget source code directory
    2. Edit with Notepad
    3. Zip with 7Zip
    4. Navigate to the widget source directory on the command line
    5. Run bbwp.exe using a relative path to the executable
    6. Load the .cod file into the simulator (delete any existing versions first, or reset the simulator)
    7. Test
  • The .jar files referenced must be included in the .zip file prior to packaging. The documentation says to place them under the ext directory, and the ext directory has to be at the same level as the index.html and config.xmlfiles. Be sure to add them into the .zip file
  • A great appreciation for the approach. Although I’m not likely to use it (to me a Smartphone is just a phone, not worthy or in need of nifty software), it is definitely a revolutionary way to allow developers to support multiple devices with a core set of functionality. That said, adoption by other mobile device makers is necessary to make this of value. In all likelihood, there will be some common ground and some custom elements for every device. Innovative package assembly may make it possible to create platform independent applications and widgets. If that is the long range goal, the application architecture must be designed carefully, separating the core functionality from device specific interfaces.
  • Using Eclipse would probably speed the edit/test/revise cycle.
  • If I was a BlackBerry developer, I’d definitely test it out.
  • Audio file delivered through the browser to a BlackBerry are not cached on the device (

    Streamed content is not saved; users cannot replay media unless they download it again.

    This was a side trip.

  • SmartPhones will play an increasingly important role in content and application delivery, web applications should consider providing suitable interfaces for them.

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.

Word VBA Macro to Remove All Bookmarks in a Document

This macro removes all the bookmarks from a Word (2007) Document. I use it to update documents which are imported from Framemaker and had a lot of unused bookmarks.

It may not be the most efficient code, but it does work.

The approach is to create an array of bookmark names or ids, and then loop through and remove them.

Note the ShowHidden, which ensures the entire collection is accessible.

Sub ClearBookmarks()
' ClearBookmarks Macro
Dim I, L, Bees() As String, aBookmark
ActiveDocument.Bookmarks.ShowHidden = True
MsgBox "There are " + Str(ActiveDocument.Bookmarks.Count) + " bookmarks"
I = 1
L = ActiveDocument.Bookmarks.Count
ReDim Bees(L)
For Each aBookmark In ActiveDocument.Bookmarks
    If IsObject(aBookmark) Then
        On Error GoTo Skip
        Bees(I) = aBookmark.Name
        I = I + 1
    End If
Next aBookmark

I = LBound(Bees)
L = UBound(Bees)
For I = I To L
    If Bees(I) <> "" Then
        If ActiveDocument.Bookmarks.Exists(Name:=Bees(I)) Then
        End If
    End If
MsgBox "There are " + Str(ActiveDocument.Bookmarks.Count) + " bookmarks"
End Sub

The Bees array is very busy. :)

1 2 4