How to Batch Extract All Bookmarks from Your Word Document

In today’s article, we would like to share with you the steps to batch extract all bookmarks from your Word document as to view them at once.

In Word, you can generate a table of contents or a table of figures with the built-in function. But, you will ultimately find there is no usual way to extract all bookmarks of a document and arrange them on a new document.

Like always, our mission is to lead you through the myth and provide you with the macro way to export all bookmarks as well as their texts to a new blank document.

Batch Extract All Bookmarks from a Single Document

1. To start off, open the target document and press “Alt+ F11” to invoke the VBA editor.
2. Next click “Normal” and then “Insert”.
3. And choose “Module” to create a new one under “Normal” project.
4. Then double click on it to bring out the editing space.
5. Paste the following macro there:

Sub ExtractBookmarksInADoc()
  Dim objBookmark As Bookmark
  Dim objTable As Table
  Dim nRow As Integer
  Dim objDoc As Document, objNewDoc As Document
  Dim objParagraph As Paragraph
 
  Set objDoc = ActiveDocument
 
  If objDoc.Bookmarks.Count = 0 Then
    MsgBox ("There is no bookmark in this document.")
  Else
    Set objNewDoc = Documents.Add
 
    Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
 
    Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)
    objTable.Borders.Enable = True
    nRow = 1
 
    For Each objParagraph In objNewDoc.Paragraphs
      If objParagraph.Range.Style = "Caption" Then
        objParagraph.Range.Delete
      End If
    Next objParagraph
 
    With objTable
      .Cell(1, 1).Range.Text = "Name"
      .Cell(1, 2).Range.Text = "Texts"
      .Cell(1, 3).Range.Text = "Page Number"
 
      For Each objBookmark In objDoc.Bookmarks
        objTable.Rows.Add
        nRow = nRow + 1
        .Cell(nRow, 1).Range.Text = objBookmark.Name
        .Cell(nRow, 2).Range.Text = objBookmark.Range.Text
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _
          SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
      Next objBookmark
    End With
  End If
  objNewDoc.SaveAs2 FileName:=objDoc.Path & "\" & "Bookmarks in " & objDoc.Name
End Sub

6. Last but not the least, click “Run”.

All bookmarks of the current document will be put in a table on a new document saved at under the same directory as the original file.

You can see table of 3 columns in the new document. And if you follow the “Ctrl+ Click”, it will bring you to the bookmark in the original document.

Batch Extract Bookmarks from Multiple Documents

Follow the same steps above to install and run a macro. Only this time, you replace the codes with the bellowing ones:

Sub ExtractBookmarksInMultiDoc()
  Dim objBookmark As Bookmark
  Dim objTable As Table
  Dim nRow As Integer
  Dim objDoc As Document, objNewDoc As Document
  Dim objParagraph As Paragraph
  Dim strFolder As String, strFile As String
 
  strFolder = InputBox("Enter folder path here: ")
  strFile = Dir(strFolder & "*.docx", vbNormal)
 
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & strFile)
    Set objDoc = ActiveDocument
    Set objNewDoc = Documents.Add
 
    Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
 
    Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)
    objTable.Borders.Enable = True
    nRow = 1
 
    For Each objParagraph In objNewDoc.Paragraphs
      If objParagraph.Range.Style = "Caption" Then
        objParagraph.Range.Delete
      End If
    Next objParagraph
 
    With objTable
      .Cell(1, 1).Range.Text = "Name"
      .Cell(1, 2).Range.Text = "Texts"
      .Cell(1, 3).Range.Text = "Page Number"
 
      For Each objBookmark In objDoc.Bookmarks
        objTable.Rows.Add
        nRow = nRow + 1
        .Cell(nRow, 1).Range.Text = objBookmark.Name
        .Cell(nRow, 2).Range.Text = objBookmark.Range.Text
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _
          SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
      Next objBookmark
    End With
    objNewDoc.SaveAs2 FileName:=objDoc.Path & "\" & "Bookmarks in " & objDoc.Name
    objDoc.Close
    strFile = Dir()
  Wend
End Sub

Once you run the macro, there is an input box. Enter the folder path where you store all the documents. And remember to add “\” at the end of the path if you just copy it from the folder text box. Then click “OK”.

How to Quickly Rescue Yourself from Data Disaster

The data disaster we talk about in Word can happen whenever it stops working abnormally. Sometimes, you get lucky and have all information intact. And other times, you fall victim to the disaster. Therefore, the quickest way to retrieve as much data as possible is to obtain a tool to fix docx.

Author Introduction:

Vera Chen is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair xlsx and pdf repair software products. For more information visit www.datanumen.com