批量将word文档中的信息提取出来存储到Excel中，拒绝加班的法宝

最近，有小伙伴跟我提了一个需求，小伙伴是做扶贫工作的，从扶贫系统里面可以批量的导出每一户的信息到一个word文档中，导出的内容是在word中是以表格的形式存在的。小伙伴的需求是如何批量的将每个word文档中的贫困户信息汇总到Excel表格中，生成一个汇总的表格，方便进行数据分析比对。为了模拟以上需求，本人设计了一个模拟的业务场景。Word文档中存储了每一位学生的考试成绩信息，模板如下：

每一位学生的成绩是一个word文档，文件以学生姓名命名，如下所示：

内容如下：

我们需要得到的结果是以下形式：

如何实现该业务逻辑呢？没错，VBA就是一个不错的选择。学过VBA的小伙伴都知道，在Excel VBA中我们可以直接打开word文档，然后在word文档中是以表格的形式存放数据，此时我们可以直接获取到表格对象，获取到表格对象以后就可以采用和Excel表格类似的办法取出单元格中的数据。下面就给大家介绍一下VBA代码的实现。

1.定义变量

定义wordapp为word应用程序对象，mydoc为word文档对象，mytab为word表格对象。代码如下：

Dim wordapp As Object, mytab As Object,mydoc as Object

定义字符串类型的变量dirpath用于存储需要合并的word文档所在文件夹的路径，myfile用于存储文件的名称。

Dim dirpath$, myfile$

2.创建word应用程序对象

通过创建对象的方式创建word应用程序对象，代码如下：

Set wordapp = CreateObject("word.application")

3.定义word文件存放路径

定义需要合并的word文档所在的路径，ThisWorkbook.Path获取到的是本Excel文件所在的路径。

dirpath = ThisWorkbook.Path & "/word/"

4.获取路径下word文档合集

通过Dir函数可以获取到指定文件夹下的所有文件。

myfile = Dir(dirpath & "*.docx")

5.清空汇总的Excel表中的内容

在开始新的合并之前，需要将Excel中指定区域的内容清空。

Range("a2:h10000").ClearContents

6.循环读取文件夹下文档

使用Do While循环语句循环读取文件夹的文件

Do While myfile ""

Loop

7.打开word文件

使用Open方法可以打开word文档。

Set mydoc = wordapp.Documents.Open(dirpath & myfile)

8.获取表格对象

Set mytab = mydoc.tables(1)

9.获取word表格中单元格内容，存储到excel

通过表格的cell方法（类似Excel中的cells的用法，注意这里没有s），读取单元格的内容，然后存储到Excel汇总表中。此时，在读取内容的过程中，最后会读取出一个特殊字符，此时我们可以自定义一个函数，将读取内容的最后一个字符去除。函数如下：

Function tt(rtext)

tt = Left(rtext, Len(rtext) - 1)

End Function

读取的代码如下：

Cells(i, 1) = tt(mytab.Cell(1, 2).Range.Text)

Cells(i, 2) = tt(mytab.Cell(1, 4).Range.Text)

Cells(i, 3) = tt(mytab.Cell(2, 2).Range.Text)

Cells(i, 4) = tt(mytab.Cell(3, 2).Range.Text)

Cells(i, 5) = tt(mytab.Cell(4, 2).Range.Text)

Cells(i, 6) = tt(mytab.Cell(4, 4).Range.Text)

Cells(i, 7) = tt(mytab.Cell(5, 2).Range.Text)

Cells(i, 8) = tt(mytab.Cell(5, 4).Range.Text)

10.读取完成后跳转到下一个文件

myfile = Dir

11.关闭文档

Word文档和word程序在所有操作完成后，需要进行关闭操作。

mydoc.Close False

wordapp.Quit

完整的代码如下：

您看此文用

·

秒，转发只需1秒呦~