求助：批量提取数千Word文档前两行至Excel的VBA解决方案

修改后的VBA代码 #

Sub BatchExtractWordFirstTwoLines()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim fileDialog As FileDialog
    Dim selectedFiles As Variant
    Dim fileIndex As Long
    Dim excelRow As Long
    Dim paraCount As Integer
    Dim wPara As Word.Paragraph
    
    ' 初始化Excel起始行（从第1行开始）
    excelRow = 1
    
    ' 打开文件选择对话框，允许批量选择docx文档
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fileDialog
        .Filters.Clear
        .Filters.Add "Word文档", "*.docx"
        .AllowMultiSelect = True
        If .Show <> -1 Then Exit Sub ' 用户取消选择则退出
        selectedFiles = .SelectedItems
    End With
    
    ' 启动Word后台进程，不显示界面
    Set wApp = CreateObject("Word.Application")
    wApp.Visible = False
    
    ' 遍历所有选中的文档
    For fileIndex = LBound(selectedFiles) To UBound(selectedFiles)
        Set wDoc = wApp.Documents.Open(selectedFiles(fileIndex), ReadOnly:=True)
        paraCount = 0
        
        ' 遍历文档段落，提取前两个有效段落
        For Each wPara In wDoc.Paragraphs
            ' 过滤文本框内的段落和空段落
            If wPara.Range.InlineShapes.Count = 0 And Trim(wPara.Range.Text) <> vbCr Then
                Select Case paraCount
                    Case 0: Sheet1.Cells(excelRow, 1).Value = Trim(wPara.Range.Text) ' 第一行写入A列
                    Case 1: 
                        Sheet1.Cells(excelRow, 2).Value = Trim(wPara.Range.Text) ' 第二行写入B列
                        Exit For ' 取完两行即停止遍历
                End Select
                paraCount = paraCount + 1
            End If
        Next wPara
        
        wDoc.Close SaveChanges:=False ' 关闭文档不保存
        excelRow = excelRow + 1 ' 准备处理下一个文档，切换到Excel下一行
    Next fileIndex
    
    ' 清理对象并关闭Word
    wApp.Quit
    Set wDoc = Nothing
    Set wApp = Nothing
    MsgBox "批量提取完成！"
End Sub

使用说明 #

1. 打开Excel，按Alt + F11打开VBA编辑器。
2. 右键点击左侧的工作簿，选择「插入」→「模块」，将上述代码粘贴进去。
3. 点击工具栏的「运行」按钮（或按F5），在弹出的对话框中选择所有需要处理的docx文档即可。

关键改进点 #

• 批量处理：通过文件对话框支持一次性选择多个文档，无需逐个修改路径。
• 排除文本框内容：利用InlineShapes.Count = 0判断段落是否属于主文档，过滤文本框内的内容。
• 精准提取前两行：设置计数器只提取前两个非空段落，分别写入Excel的A、B列，符合需求。
• 后台运行：Word在后台执行，不会弹出大量窗口干扰操作。

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