Excel VBA 实例（23） - 一键批量提取word表格内

今天的这个实例来自公号的一位粉丝，如下图：

这里有若干份同样表格，但是不同内容的word文档。需求是：将所有的word里面表格的内容全部汇总到一个excel表格当中，如下图：

没错，word里面同样也是可以用vba代码的。

思路也是很简单：遍历读取每个word文档，提取指定的表格内容到excel表中即可，源代码如下，大部分网上都有现成的，永恒君做了一些修改而言。

Sub提取word表格()

mypath = ThisWorkbook.Path &"\"

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

m =1

DoWhilemyname <>""

Setmydoc =GetObject(mypath & myname)

Withmydoc

m = m +1

With.Tables(1)

Cells(m,1) = m -1'序号

Range("A1:F1") =Array("序号","姓名","性别","身份证号","住址","联系方式")

Cells(m,2) =Replace(.cell(1,2).Range.Text,"","")

Cells(m,3) =Replace(.cell(2,2).Range.Text,"","")

Cells(m,4) =Replace(.cell(3,2).Range.Text,"","")

Cells(m,5) =Replace(.cell(4,2).Range.Text,"","")

Cells(m,6) =Replace(.cell(5,2).Range.Text,"","")

EndWith

.CloseFalse

EndWith

myname = Dir()

Loop

Setmydoc =Nothing

MsgBox"提取完成"

EndSub

看一下效果：

是不是很神奇？

如果你在操作过程中有疑问，欢迎来交流。源文件准备好，需要的话再后台回复「word表格」即可。

相关阅读：

Excel VBA 实例（22） - 一键筛选其他工作表或工作簿的数据

Excel vba 实例(21) - 如何快速准确录入数据

Excel vba 实例(20) - 一键填充每月员工拜访地区

欢迎加入我的知识星球，为您提供更多VBA、python等效率提升服务和资源！