批量word报告里数据自动写到Excell用于统计分析

1、打开报告所在的文件夹，新建一个Excell，先不要有任何操作

2、找到EXCELL中开发工具及代码编写框。按以下步骤点击文件，选项，自定义功能区，开发工具（前面打勾），开发工具，visual Basic, 视图，复制粘贴代码，运行知道出现提取完毕即可！

3、复制粘贴的代码如下：

Sub 提取word表格()

mypath = ThisWorkbook.Path & "\"

myname = Dir(mypath & "*.docx")

m = 2

Do While myname <> ""

Set mydoc = GetObject(mypath & myname)

With mydoc

With .tables(1)

    For i = 3 To mydoc.tables(1).Rows(3).Cells.Count

    Cells(m, 1).Value = Split(mydoc.tables(1).Cell(1, 4).Range, Chr(13))(0) '取样日期

    Cells(m, 2).Value = Split(mydoc.tables(1).Cell(1, 6).Range, Chr(13))(0) '检验日期

    Cells(m, 3).Value = Split(mydoc.tables(1).Cell(2, 6).Range, Chr(13))(0) '报告日期

    Cells(m, 4).Value = Split(mydoc.tables(1).Cell(3, i).Range, Chr(13))(0) '取样点

    Cells(m, 5).Value = Split(mydoc.tables(1).Cell(9, i).Range, Chr(13))(0) '电导率

    Cells(m, 6).Value = Split(mydoc.tables(1).Cell(11, i).Range, Chr(13))(0) '不挥发物

    Cells(m, 7).Value = Split(mydoc.tables(1).Cell(13, i).Range, Chr(13))(0) '微生物度

    m = m + 1

    Next i

End With

.Close False

End With

myname = Dir()

Loop

Set mydoc = Nothing

MsgBox "提取完成"

End Sub

4、我的每张word报告且每张报告里只有一个表格格式如图所示，提取完后的数据格式同样如图所示。