批量提取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
相关推荐
程序员陆通9 分钟前
Cursor配置markdown转Word的MCP工具教程
word
shandianchengzi3 小时前
【经验】Word/WPS|用邮件合并批量填写表格或教案,单个Word导出成多个文件
word·wps·邮件·办公·邮件合并
zstar-_11 小时前
FreeP2W:一个PDF转Word的CLI工具
pdf·word
njsgcs12 小时前
读取文件夹内的pdf装换成npg给vlm分类人工确认然后填入excel vlmapi速度挺快 qwen3-vl-plus webbrowser.open
分类·pdf·excel
星空的资源小屋12 小时前
Tuesday JS,一款可视化小说编辑器
运维·网络·人工智能·编辑器·电脑·excel
sinat_3751122613 小时前
abap 通用发送邮件程序(获取alv数据,带excel附件)
excel·sap·abap·邮件
忘忧记13 小时前
Excel拆分和合并优化版本
windows·microsoft·excel
牵牛老人14 小时前
Qt 中如何操作 Excel 表格:主流开源库说明介绍与 QXlsx 库应用全解析
qt·开源·excel
十碗饭吃不饱14 小时前
RuoYi/ExcelUtil修改(导入excel表时,表中字段没有映射上数据库表字段)
数据库·windows·excel
JXL186019 小时前
CS224N-Lecture01-Word Vectors
nlp·word