批量提取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
相关推荐
葡萄城技术团队16 小时前
从100秒到10秒的性能优化,你真的掌握 Excel 的使用技巧了吗?
excel
玩泥巴的2 天前
.NET驾驭Word之力:理解Word对象模型核心 (Application, Document, Range)
word·二次开发·office·com互操作
QQ3596773452 天前
ArcGIS Pro实现基于 Excel 表格批量创建标准地理数据库(GDB)——高效数据库建库解决方案
数据库·arcgis·excel
玩泥巴的3 天前
.NET驾驭Word之力:COM组件二次开发全攻略之连接Word与创建你的第一个自动化文档
word·二次开发·com互操作
星空的资源小屋3 天前
Digital Clock 4,一款免费的个性化桌面数字时钟
stm32·单片机·嵌入式硬件·电脑·excel
揭老师高效办公4 天前
在Excel和WPS表格中批量删除数据区域的批注
excel·wps表格
我是zxb4 天前
EasyExcel:快速读写Excel的工具类
数据库·oracle·excel
辣香牛肉面4 天前
[Windows] 搜索文本2.6.2(从word、wps、excel、pdf和txt文件中查找文本的工具)
word·excel·wps·搜索文本
ljf88384 天前
Java导出复杂excel,自定义excel导出
java·开发语言·excel
tebukaopu1484 天前
json文件转excel
json·excel