如何从多个相同格式word文件中的信息批量提取数据到excel

韩超2014

求助各位大佬，我想把N多个相同格式的word文件【人员表】表格中的有关人员信息表批量提取到EXCEL【人员信息统计表】中，请问怎么操作，谢谢，请各路大佬帮帮忙！！！

乐乐2006201505

Sub ExtractDataFromWordToExcel()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim ExcelSheet As Worksheet
    Dim LastRow As Long
    Dim SourceFolder As String
    Dim FileName As String
    Dim TableIndex As Integer
   
    ' 设置源文件夹路径
    SourceFolder = "C:\Your\Path\Here\" ' 请替换为你的文件夹路径
   
    ' 创建Word应用程序实例
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
   
    ' 设置目标Excel工作表
    Set ExcelSheet = ThisWorkbook.Sheets(1) ' 假设数据将被复制到第一个工作表
    LastRow = ExcelSheet.Cells(ExcelSheet.Rows.Count, "A").End(xlUp).Row + 1
   
    ' 遍历文件夹中的所有Word文档
    FileName = Dir(SourceFolder & "*.docx") ' 请根据需要修改文件扩展名
    Do While FileName <> ""
        Set wdDoc = wdApp.Documents.Open(SourceFolder & FileName)
        
        ' 遍历文档中的所有表格
        For TableIndex = 1 To wdDoc.Tables.Count
            ' 将表格数据复制到Excel
            wdDoc.Tables(TableIndex).Range.Copy
            ExcelSheet.Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues
            LastRow = LastRow + wdDoc.Tables(TableIndex).Rows.Count
        Next TableIndex
        
        ' 关闭Word文档
        wdDoc.Close False
        FileName = Dir() ' 获取下一个文件名
    Loop
   
    ' 清理
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Application.CutCopyMode = False
   
    MsgBox "数据提取完成！"
End Sub

李波001

这个应该可以满足你的需要