Macro to list all bookmarks

[Marrick13]

I have two macro routines, ListBookmarks1 and ListBookmarks2, that are intended to capture bookmarks in a Word document.

ListBookmarks1 uses a for loop to get the bookmarks, while ListBookmarks2 writes the bookmarks to an array. The difference is that ListBookmarks1 ignores the bookmarks in headers, footers, shapes and other stories, while ListBookmarks2 captures all bookmarks because of the array. Apparently, bookmarks in headers, footers, and shapes aren't part of the Document.Bookmark collection. What’s odd is that ActiveDocument.Bookmarks.count produces a count of all bookmarks, including those outside the bookmark collection.

ListBookmarks1 writes the bookmarks it does find to a new document, and ListBookmarks2 writes them to either a new document or a message box (depending on what code is commented out). Both include each bookmark’s location (page and line number).

The problem I’m having is that I am not able to get the array to display properly in either the new Word doc or the message box. The attached test doc contains the macros and eight bookmarks – 5 in the body, 1 in the header, 1 in a shape, and 1 in a table. I have switched on the “show bookmarks” and written their names followed by “BOOKMARK” in bold italics to make them easier to find.

The bookmarks are:

Browser
DOS
Header
IPadd
PhysAdd
Status
Tablebkmk
Txtbox

ListBookmarks1 correctly shows 8 bookmarks with their locations (it ignores “Browser“ and “Txtbox”).

ListBookmarks2 shows the first 7 but the locations are mismatched by one row. However, all bookmarks and locations are captured in the array; it is evidently the display that’s not working properly in both the document and msgbox displays. Can someone help with the displays?

[macropod]

Hi Marrick,

Try something based on the following. As coded, it adds the list to then end of the current document, but you could change that:

Sub ListBkMrks()
Application.ScreenUpdating = False
Dim oBkMrk As Bookmark, Rng As Range, StrTxt As String, StrStory As String
With ActiveDocument
  Set Rng = .Range.Characters.Last
  If .Bookmarks.count > 0 Then
    With Rng
    .Text = vbCrLf & "Bookmark" & vbTab & "Page" & vbTab & "Line" & vbTab & "Story Range" & vbTab & "Contents"
    For Each oBkMrk In ActiveDocument.Bookmarks
      .InsertAfter vbCrLf & oBkMrk.Name & vbTab
      .InsertAfter oBkMrk.Range.Characters.First.Information(wdActiveEndAdjustedPageNumber)
      .InsertAfter vbTab & oBkMrk.Range.Information(wdFirstCharacterLineNumber)
      Select Case oBkMrk.StoryType
        Case 1: StrStory = "Main text"
        Case 2: StrStory = "Footnotes"
        Case 3: StrStory = "Endnotes"
        Case 4: StrStory = "Comments"
        Case 5: StrStory = "Text frame"
        Case 6: StrStory = "Even pages header"
        Case 7: StrStory = "Primary header"
        Case 8: StrStory = "Even pages footer"
        Case 9: StrStory = "Primary footer"
        Case 10: StrStory = "First page header"
        Case 11: StrStory = "First page footer"
        Case 12: StrStory = "Footnote separator"
        Case 13: StrStory = "Footnote continuation separator"
        Case 14: StrStory = "Footnote continuation notice"
        Case 15: StrStory = "Endnote separator"
        Case 16: StrStory = "Endnote continuation separator"
        Case 17: StrStory = "Endnote continuation notice"
        Case Else: StrStory = "Unknown"
      End Select
      .InsertAfter vbTab & StrStory & vbTab & oBkMrk.Range.Text
    Next oBkMrk
    .Start = .Start + 1
    .ConvertToTable Separator:=vbTab
    .Tables(1).Rows.First.Range.Font.Bold = True
  End With
End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Bookmarks are listed alphabetically, whereas to were apparently trying to sort them by story range. You could sort the table on that column, if you wish.

Note too that the line numbers for some bookmarks will come out as -1. That's because line numbers only apply to the main story.

[Marrick13]

Thanks so much, Paul - that's great. I did wonder why the -1; figured Word couldn't determine a line. Any chance you could tell me how to adapt this code so the table will be created in a new document? That's my preference (but since you made it write to the active doc, I wouldn't mind offering a choice of destination document).

I also still don't understand how your code gets all the bookmarks, when I ran loops that missed the header and shapes.

[macropod]

Hi Marrick,

Try:

Sub ListBkMrks()
Application.ScreenUpdating = False
Dim oBkMrk As Bookmark, Rng As Range, StrTxt As String, StrStory As String, wdDocIn As Document, wdDocOut As Document, Dest
Dest = MsgBox(Prompt:="Output to New Document? (Y/N)", Buttons:=vbYesNoCancel, Title:="Destination Selection")
If Dest = vbCancel Then Exit Sub
Set wdDocIn = ActiveDocument
If Dest = vbYes Then Set wdDocOut = Documents.Add
If Dest = vbNo Then Set wdDocOut = wdDocIn
With wdDocIn
  If .Bookmarks.Count > 0 Then
    StrTxt = vbCr & "Bookmark" & vbTab & "Page" & vbTab & "Line" & vbTab & "Story" & Chr(160) & "Range" & vbTab & "Contents"
    For Each oBkMrk In .Bookmarks
      StrTxt = StrTxt & vbCrLf & oBkMrk.Name & vbTab
      StrTxt = StrTxt & oBkMrk.Range.Characters.First.Information(wdActiveEndAdjustedPageNumber)
      StrTxt = StrTxt & vbTab & oBkMrk.Range.Information(wdFirstCharacterLineNumber)
      Select Case oBkMrk.StoryType
        Case 1: StrStory = "Main text"
        Case 2: StrStory = "Footnotes"
        Case 3: StrStory = "Endnotes"
        Case 4: StrStory = "Comments"
        Case 5: StrStory = "Text frame"
        Case 6: StrStory = "Even pages header"
        Case 7: StrStory = "Primary header"
        Case 8: StrStory = "Even pages footer"
        Case 9: StrStory = "Primary footer"
        Case 10: StrStory = "First page header"
        Case 11: StrStory = "First page footer"
        Case 12: StrStory = "Footnote separator"
        Case 13: StrStory = "Footnote continuation separator"
        Case 14: StrStory = "Footnote continuation notice"
        Case 15: StrStory = "Endnote separator"
        Case 16: StrStory = "Endnote continuation separator"
        Case 17: StrStory = "Endnote continuation notice"
        Case Else: StrStory = "Unknown"
      End Select
      StrTxt = StrTxt & vbTab & StrStory & vbTab & oBkMrk.Range.Text
    Next oBkMrk
  Else
    MsgBox "There are no bookmarks in this document", vbExclamation
    GoTo Done
  End If
End With
With wdDocOut
  Set Rng = .Range.Characters.Last
  With Rng
    .Text = StrTxt
    .Start = .Start + 1
    .ConvertToTable Separator:=vbTab
    With .Tables(1)
      .AutoFitBehavior wdAutoFitContent
      .Columns.Borders.Enable = True
      .Rows.Borders.Enable = True
      .Rows.First.Range.Font.Bold = True
    End With
  End With
End With
Done:
Set Rng = Nothing: Set wdDocIn = Nothing: Set wdDocOut = Nothing
Application.ScreenUpdating = True
End Sub

As for:

I also still don't understand how your code gets all the bookmarks, when I ran loops that missed the header and shapes

I guess that has something to do with the fact I looped through the bookmarks collection and retrieved the corresponding storyranges, whereas you tried to identify bookmarks associated with storyranges. Why one should work and the other fail, I'm not sure.

[Marrick13]

Brilliant, Paul! I don't know how you do it..I keep biting off way more than I can chew. Your help is invaluable - thanks again.