VBA Exporting Microsoft Word Bookmarks and Selection Text to Excel Spreadsheet

Question

I've recently been put in charge of document standardization for a client at my work. They're government so I can't really post anything in the way of examples for reference. Sorry.

What I'm trying to do in VBA is have a Word Document that has roughly 80 bookmarks (There are 27 files I have to do this to) extract the .Name of the bookmark and .Selection to an Excel sheet.

As an example I offer the following:

Hello, my name is World!

If the above is a word document, World! is the .Selection of the Bookmark and (Doc_World) would be the bookmark name. I'm trying to write the macro that will write "Doc_World" and "World!" to an excel sheet.

The last caveat is that nothing is currently standardized, so I would need it to just cycle through bookmarks in the current open document.

I actually managed to find something that sort of did what I wanted, and then spliced some other info I found together to create something that worked, but you had to create all the xls files before hand. @RachelHettinger has a much, much more elegant answer than I came up with on my own. For the sake of reference, the following is my frankenstein:

Sub WdBkMktoXL()
Dim ObjExcel As Object, ObjWorkBook As Object, ObjWorksheet As Object
Dim Bmk() As String
Dim x As Integer, J As Integer

Set ObjExcel = CreateObject("EXCEL.APPLICATION")
Set ObjWorkBook = ObjExcel.Workbooks.Open("C:\Users\Zach\Desktop\ETTP\TermsAndConditions\1.xlsx")
Set ObjWorksheet = ObjWorkBook.Worksheets("Sheet1")

x = ActiveDocument.Bookmarks.Count
ReDim Bmk(x)
For J = 1 To x
Bmk(J) = ActiveDocument.Bookmarks(J).Name
ObjWorksheet.Range("A" & J) = ActiveDocument.Bookmarks(J).Range.Text
ObjWorksheet.Range("B" & J) = ActiveDocument.Bookmarks(J).Name
Next J

ObjWorkBook.Save
ObjWorkBook.Close
Set ObjWorksheet = Nothing
Set ObjWorkBook = Nothing
ObjExcel.Quit
Set ObjExcel = Nothing
End Sub

Answer 1

If I understand your needs correctly, this macro should help. It loops through all bookmarks in the active document and exports them to a new file in Excel:

Sub ExportBookmarksToExcel()
    Dim bk As Bookmark
    Dim appXl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wst As Excel.Worksheet
    Dim lRow As Long

    Set appXl = CreateObject("Excel.Application")
    With appXl
        .Visible = True
        Set wbk = .Workbooks.Add
        Set wst = wbk.Worksheets(1)
        lRow = 1
        wst.Cells(lRow, 1) = "Bookmark name"
        wst.Cells(lRow, 2) = "Bookmark text"
        wst.Rows(lRow).Font.Bold = True
    End With

    For Each bk In ActiveDocument.Bookmarks
        lRow = lRow + 1
        wst.Cells(lRow, 1) = bk.Name
        wst.Cells(lRow, 2) = bk.Range.Text
    Next bk
    wst.UsedRange.Columns.AutoFit

End Sub

Note 1: Because this code uses early binding, it requires a reference to the Excel library (Tools: References). Note 2: It uses CreateObject to create the instance of Excel, so every time the macro runs, a new instance is created. (GetObject will use an existing instance but fails if none is found.)