批量提取word表格数据到一个excel

  1. 新建一个excel到word同级目录
  2. alt+f11打开vba窗口并新建模块
  3. 粘贴下方代码(修改一些必要参数)
  4. 回到excel表格界面,alt+f8选择执行该宏
  5. 注意要在信任中心开启运行vba宏
vbnet 复制代码
Sub 批量提取word表格数据到excel()
    Dim wdApp As Object, wdDoc As Object
    Dim fso As Object, folder As Object, file As Object
    Dim excelRow As Long, iRow As Long, iCol As Integer
    Dim tableNo As Integer
    Dim folderPath As String    

    tableNo = 1 ' 修改为实际表格序号,默认第一个表格
    excelRow = 1 ' Excel起始行
    folderPath = ActiveWorkbook.Path & "\" ' word文件所在目录
    
    ' 创建文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    
    ' 初始化Word
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    wdApp.Visible = False ' 隐藏Word窗口
    
    ' 遍历文件夹中的每个Word文档
    For Each file In folder.Files
        If (fso.GetExtensionName(file.Path) = "doc") Or (fso.GetExtensionName(file.Path) = "docx") Then
            Set wdDoc = wdApp.Documents.Open(file.Path)
            
            ' 检查文档中是否存在表格
            If wdDoc.Tables.Count >= tableNo Then
                With wdDoc.Tables(tableNo)
                    ' 复制表格数据到Excel
                    ' 1.遍历姓名
                     For iRow = 5 To 5
                        For iCol = 2 To 2
                            ' 去除换行符和空格并写入Excel
                            Cells(excelRow, iCol - 1).Value = WorksheetFunction.Clean(Replace(.Cell(iRow, iCol).Range.Text, vbCr, ""))
                        Next iCol
                        excelRow = excelRow + 1
                    Next iRow
                    
                    ' 2.遍历成绩
                    For iRow = 3 To 3
                        For iCol = 5 To 5
                            ' 去除换行符和空格并写入Excel
                            Cells(excelRow - 1, iCol - 3).Value = WorksheetFunction.Clean(Replace(.Cell(iRow, iCol).Range.Text, vbCr, ""))
                        Next iCol
                        excelRow = excelRow
                    Next iRow
                    ' 3.遍历其他数据信息
                    ' ' ' ' ' ' ' 
                End With
            End If
            
            wdDoc.Close SaveChanges:=False
        End If
    Next file
    
    ' 清理缓存数据
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set fso = Nothing
    
    MsgBox "提取完毕!找到文件数量:" & folder.Files.Count-2
End Sub
相关推荐
Roye_ack14 小时前
【项目实战 Day12】springboot + vue 苍穹外卖系统(Apache POI + 工作台模块 + Excel表格导出 完结)
java·spring boot·后端·excel·苍穹外卖
MK42217 小时前
Word卡顿,过很久才弹窗网络连接失败解决办法
word·word卡顿·officeplus·网络连接失败
IccBoY20 小时前
Java采用easyexcel组件进行excel表格单元格的自动合并
java·开发语言·excel
Metaphor69221 小时前
Java 将 HTML 转换为 Word:告别手动复制粘贴
java·经验分享·html·word
风车带走过往1 天前
Excel 常用功能自救手册:遇到问题快速排查指南 (个人备忘版)
excel
跟着珅聪学java1 天前
EasyExcel 读取 Excel 文件指南
excel
芭拉拉小魔仙2 天前
Vue项目中如何实现表格选中数据的 Excel 导出
前端·vue.js·excel
RE-19012 天前
Excel基础知识 - 导图笔记
数据分析·学习笔记·excel·思维导图·基础知识·函数应用
Love__Tay2 天前
【数据分析与可视化】2025年一季度金融业主要行业资产、负债、权益结构与增速对比
金融·excel·pandas·matplotlib