如何通过Excel VBA获取Word文档中特定术语对应的段落号与页码

完全可以通过Excel VBA调用Word对象模型实现该需求，以下是完整实现方案：

前置准备 #

• 打开Excel VBA编辑器（快捷键Alt+F11），依次点击「工具」→「引用」，勾选Microsoft Word xx.x Object Library（xx.x对应你本机安装的Office版本号，16.0对应Office2016/2019/365版本）
• 提前确认术语匹配规则：是否需要精确匹配、是否区分大小写，可在后续代码中调整对应参数

核心实现逻辑 #

1. 从Excel侧启动Word应用实例，打开目标Word文档
2. 调用Word原生查找功能定位所有匹配指定术语的内容
3. 匹配成功后读取对应内容所属的段落号、所在页码
4. 将匹配结果批量写入Excel工作表
5. 处理完成后关闭Word文档，释放所有对象资源避免内存残留

可直接运行的VBA代码 #

Sub 提取Word术语对应段落和页码()
    Dim wordApp As Word.Application
    Dim wordDoc As Word.Document
    Dim targetRange As Word.Range
    Dim searchText As String
    Dim filePath As Variant
    Dim outputRow As Integer
    
    ' 初始化输出位置：第1行写表头，数据从第2行开始写入
    outputRow = 2
    Sheet1.Range("A1") = "匹配术语"
    Sheet1.Range("B1") = "段落号"
    Sheet1.Range("C1") = "页码"
    
    ' 选择要处理的Word文档
    filePath = Application.GetOpenFilename("Word文件(*.docx;*.doc), *.docx;*.doc", , "选择目标Word文档")
    If filePath = False Then Exit Sub
    
    ' 输入要查找的特定术语
    searchText = InputBox("请输入要查找的特定术语：", "输入查找内容")
    If searchText = "" Then Exit Sub
    
    ' 初始化Word应用实例
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wordApp = New Word.Application
    End If
    On Error GoTo 0
    wordApp.Visible = False ' 调试时可改为True查看Word运行过程
    
    ' 打开目标Word文档
    Set wordDoc = wordApp.Documents.Open(filePath)
    Set targetRange = wordDoc.Content
    
    ' 执行查找匹配
    With targetRange.Find
        .ClearFormatting
        .Text = searchText
        .MatchWholeWord = True ' 不需要精确匹配则改为False
        .MatchCase = False ' 需要区分大小写则改为True
        Do While .Execute = True
            Sheet1.Range("A" & outputRow) = searchText
            ' 若要读取Word自动生成的段落编号，将下一句改为targetRange.Paragraphs(1).Range.ListFormat.ListString
            Sheet1.Range("B" & outputRow) = targetRange.Paragraphs(1).Index
            ' 读取匹配内容所在页码
            Sheet1.Range("C" & outputRow) = targetRange.Information(wdActiveEndPageNumber)
            outputRow = outputRow + 1
        Loop
    End With
    
    ' 清理资源
    wordDoc.Close SaveChanges:=False
    wordApp.Quit
    Set targetRange = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
    
    MsgBox "提取完成，共找到" & outputRow - 2 & "条匹配结果"
End Sub

常见调整说明 #

• 若需要批量匹配多个术语，可提前将术语写入Excel某一列，遍历该列重复执行查找逻辑即可
• 若Word文档有密码保护，需在Documents.Open方法中添加密码参数，或提前解除文档保护
• 若段落有自定义手动编号，可根据实际规则调整段落号的取值逻辑

内容的提问来源于stack exchange，提问作者Derik0003