如何修改VBA代码实现遍历文件夹所有docx文件提取Word表格到Excel

完整修改后的VBA代码 #

Sub extractAllDocxData()
    Dim wd As New Word.Application
    Dim doc As Word.Document
    Dim sh As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim lr As Long
    Dim tbls As Word.Tables
    Dim i As Integer
    
    ' 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择存放docx文件的文件夹"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & "\"
        Else
            Exit Sub ' 用户取消选择直接退出
        End If
    End With
    
    wd.Visible = False ' 可设为True显示Word界面方便调试，设为False后台运行速度更快
    Set sh = ActiveSheet
    fileName = Dir(folderPath & "*.docx") ' 仅匹配docx格式的文件
    
    ' 遍历所有符合条件的Word文件
    Do While fileName <> ""
        Set doc = wd.Documents.Open(folderPath & fileName)
        Set tbls = doc.Tables
        
        ' 仅处理表格数量符合要求的文件，避免报错
        If tbls.Count >= 5 Then
            lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row + 1
            ' 可选：将当前文件名写入第一列，方便后续溯源核对
            sh.Cells(lr, 1).Value = fileName
            
            ' 原有表格提取逻辑完全保留，无需调整
            For i = 1 To 10
                sh.Cells(lr, i + 6).Value = Application.WorksheetFunction.Clean(tbls(4).Rows(i + 1).Cells(2).Range.Text)
            Next
            For i = 1 To 10
                sh.Cells(lr, i + 16).Value = Application.WorksheetFunction.Clean(tbls(5).Rows(i + 1).Cells(2).Range.Text)
            Next
        End If
        
        doc.Close SaveChanges:=wdDoNotSaveChanges
        fileName = Dir ' 读取下一个文件
    Loop
    
    ' 所有文件处理完成后再退出Word进程
    wd.Quit
    ' 释放对象资源
    Set doc = Nothing
    Set sh = Nothing
    Set wd = Nothing
    MsgBox "所有docx文件数据提取完成！"
End Sub

关键修改说明 #

• 新增文件夹选择功能：通过系统弹窗选择目标目录，无需手动修改代码硬编码路径
• 优化Word进程调用：仅启动一次Word程序处理所有文件，比逐个文件重启Word效率高很多，也不会产生残留进程
• 自动过滤文件：仅识别.docx后缀的文件，不会误处理文件夹内其他格式文件
• 新增异常兼容：增加表格数量判断，遇到表格不足5个的Word文件会自动跳过，不会中断运行
• 新增溯源字段：自动将对应Word文件名写入每行第一列，方便后续核对数据来源

前置操作要求 #

运行代码前需要先配置VBA引用：

1. 按Alt+F11打开VBA编辑器
2. 点击顶部菜单栏「工具」→「引用」
3. 在列表中找到「Microsoft Word XX.X Object Library」（XX.X为你的Office版本号，比如16.0对应Office2016/2019/365），勾选后点击确定即可运行

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