VBA 将 Microsoft Word 书签和选择文本导出到 Excel 电子表格

Question

我最近在我的工作中负责为客户进行文档标准化。他们是政府，所以我不能以示例的方式发布任何内容以供参考。对不起。

我想在 VBA 中做的是有一个 Word 文档，它有大约 80 个书签（我必须这样做 27 个文件）提取.Name书签和.SelectionExcel 工作表。

作为一个例子，我提供以下内容：

大家好，我叫世界！

如果上面是一个word文档，World!则是书签的名称.Selection，( Doc_World)将是书签名称。我正在尝试编写将写入"Doc_World"并写入"World!"Excel 工作表的宏。

最后一个警告是目前没有任何标准化，所以我需要它来循环浏览当前打开文档中的书签。

我实际上设法找到了一些可以做我想做的事情，然后将我找到的其他一些信息拼接在一起以创建一些有用的东西，但是您必须事先创建所有 xls 文件。@RachelHettinger 的答案比我自己想出的要优雅得多。仅供参考，以下是我的弗兰肯斯坦：

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

如果我正确理解您的需求，这个宏应该会有所帮助。它遍历活动文档中的所有书签并将它们导出到 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

注 1：由于此代码使用早期绑定，因此需要引用 Excel 库（工具：参考）。注 2：它使用 CreateObject 创建 Excel 实例，因此每次运行宏时，都会创建一个新实例。（GetObject 将使用现有实例，但如果找不到则失败。）