批量提取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
相关推荐
星沙丘秋4 小时前
Kettle导入Excel文件进数据库时,数值发生错误的一种原因
excel
Tomorrow'sThinker6 小时前
✍️ Python 批量设置 Word 文档多级字体样式(标题/正文/名称/小节)
python·自动化·word·excel
Xiao_zuo_ya6 小时前
SpringBoot-Freemarker导出word
spring boot·word
[纳川]6 小时前
把word中表格转成excle文件
开发语言·c#·word
大虫小呓10 小时前
50个Python处理Excel示例代码,覆盖95%日常使用场景-全网最全
python·excel
禁默12 小时前
Linux Vim 编辑器详解:从入门到进阶(含图示+插件推荐)
linux·vim·excel
Tomorrow'sThinker1 天前
[特殊字符] Python 批量生成词云:读取词频 Excel + 自定义背景 + Excel to.png 流程解析
python·excel
UrbanJazzerati1 天前
Excel 使用中的“坑”:拆分与合并列的陷阱及解决方案
excel
Dxy12393102161 天前
word中的单位详解
word
KeThink2 天前
国民经济行业分类 GB/T 4754—2017 (PDF和exce版本)
pdf·excel