批量提取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
相关推荐
bing_1581 小时前
Word 怎么让字变大、变粗、换颜色?
word
小码氓1 小时前
Java填充Word模板
java·开发语言·spring·word
会飞的天明1 小时前
Java 导出word 实现饼状图导出--可编辑数据
java·word
NingrLi1 小时前
Word中字号与公式字体磅值(pt)的对应关系
word
星沙丘秋8 小时前
Kettle导入Excel文件进数据库时,数值发生错误的一种原因
excel
Tomorrow'sThinker10 小时前
✍️ Python 批量设置 Word 文档多级字体样式(标题/正文/名称/小节)
python·自动化·word·excel
Xiao_zuo_ya10 小时前
SpringBoot-Freemarker导出word
spring boot·word
[纳川]10 小时前
把word中表格转成excle文件
开发语言·c#·word
大虫小呓13 小时前
50个Python处理Excel示例代码,覆盖95%日常使用场景-全网最全
python·excel
禁默16 小时前
Linux Vim 编辑器详解:从入门到进阶(含图示+插件推荐)
linux·vim·excel