请问如何将多个word表格里的内容批量提取到一张excel表中？

Question

我现在有几千个word表格，都是严格按照同一种格式存储的，见图片。请问如何将里面的内容批量提取到excel中去方便统计（就算是能批量复制到一个excel中也行）？我知道用vba可以，但是不会用，从网上复制的vba代码执行后在excel中就只有一张表的内容，没法用。
我用的是Microsoft Office 2013，希望确实有效的回答。感激不尽！

Answer 1

要用VBA才能解决。
从WORD表格到EXCEL表格，相比一色的EXCEL表格 到EXCEL表格，要稍显麻烦些。

建议你按以下步骤说明问题：
1、用手工方式，把某2个WORD表格的内容提取到一个EXCEL表格里。
2、然后把这3个文件放到一个新文件夹中，一起上传到你的百度网盘，然后分享一下。
3、把分享的地址贴上来，继续追问。
然后等有好心人免费帮你解决吧。

Answer 2

Sub 自动把word表格转换到Excel()
On Error Resume Next ''''''出错继续（应对不规范的表格）

''''''重命名所有WORD文件为大写“A”。如 A (1).docx。

''maxcolumn(xex)
Dim maxrowend2
Dim wdApp
For w3 = 1 To 2 想合并多少个文档？
maxrowend2 = Sheets("sheet1").[a65536].End(xlUp).Row

Set wdApp = CreateObject("word.application")
path_ = ThisWorkbook.Path
wdApp.Documents.Open (path_ & "\" & "A (" & w3 & ")" & ".docx")
wdApp.Visible = True
n = wdApp.ActiveDocument.Tables.Count ''''有多少个表格
'x = 0
x = maxrowend2 + 1 ''''初始行号
y = 0
For i = 1 To n
rs = wdApp.ActiveDocument.Tables(i).Rows.Count ''''有多少个行
cs = wdApp.ActiveDocument.Tables(i).Columns.Count ''''有多少个列

''''''ghg = MsgBox(rs & "行列" & cs) '''''''''''''''''''''''''''''''提示

For m = 1 To rs

x = x + 1
y = 1
ThisWorkbook.Sheets("Sheet1").Cells(x, 1) = "源自A (" & w3 & ")" & ".docx" & "； 第" & i & " 表 " ''''''''''9999999999999999999
For n = 1 To cs

vv = wdApp.ActiveDocument.Tables(i).Cell(m, n)
ThisWorkbook.Sheets("Sheet1").Cells(x, y + 1) = Mid(vv, 1, Len(vv) - 1) '''空第一列
y = y + 1
Next
Next
Next
wdApp.Application.Quit '关闭word文档
Set wdApp = Nothing '释放对象变量的内存
Next

End Sub

Answer 3

设置方法：
1、单击开始----复制按钮(或按Ctrl + C组合键)时行复制；
2、在Excel中粘贴即可；

3、弹出性粘贴对话框，选择Microsoft Office Excel工作表对象， 若需要Excel中的数据变化，Word中的数据也随之变化，就选择粘贴链接，

Answer 4

确实得用VBA，有经费的话，可以试一试！

Answer 5

图片在哪里？VBA可以实现你的需求，需要联络。