求助关于word中多表格内容批量导入excel的问题

zhangaeo · 发表于 2013-2-2 15:16

要从上千word表格挑选相关内容汇总整理到一个excel表里，人工工作量太大，想到用excel解决，可是本人是VBA的门外汉，之前从没研究过。。。昨天熬夜到2点多，翻了好多帖子才大概明白一点点，但是还有关键的问题不知道该怎么办，希望能够得到大家的热心帮助！先行谢过！
附件里是需要汇总的word格式，里面从封面的表格算起有5个表格。
我需要从第2个表格，即“企业信息”里提取4项内容，从第3个表格产品“销售信息”里提取5项内容，都用红字标示出来了，最后需要从最后一个表格“产品技术规格”里提取填写的除了序号一列以外的所有内容，这个内容行数是不等的。
我现有的excel内函数是在论坛里找到的一位大神的作品，好厉害的说。可是目前只能实现从word表格里的第一个表格中提取信息，无法提取其他表格的内容，该怎么解决呢？请大家施予援手！不吝赐教！谢谢！

zhangaeo · 发表于 2013-2-2 16:22

我这边又找到一位大神，能够实现从一个WORD里的多个表格选择需要的内容整理汇总进一个excel表里，但是它只能针对一个word，不能对多个一并处理，两者能结合一下就能实现我的要求了，可是作为菜鸟我搞了半天实在搞不定。。。哪位热心大神帮帮忙吧~

示例.rar (15.88 KB, 下载次数: 233)

zhangaeo · 发表于 2013-2-2 16:42

合并之后提示“对象变量或with块变量未设置”，这个该如何设置啊。。

LMY123 · 发表于 2013-2-2 18:59

供你参考
Sub test()

Dim WordApp As Object, DOC, mTable, Fn$, Str$

On Error Resume Next '设置容错代码

CreateObject("wscript.shell").Run "cmd.exe /c dir """ & ThisWorkbook.Path & "\*.doc"" /s/b>""" & ThisWorkbook.Path & "\list.txt""", False, True    '取得指定目录下的word文档清单

Set WordApp = CreateObject("word.application")  '创建word程序项目（用于操作word文档）

WordApp.Visible = True  '设定word程序项目可见

Open ThisWorkbook.Path & "\list.txt" For Input As #1 '打开清单文件并读取内容

While Not EOF(1) '循环读取清单文件各行内容

      Input #1, Str '输入一行文本到变量str中

      If Trim(Str) <> "" Then '如果文本有效则

         Set DOC = WordApp.documents.Open(Trim(Str)) '利用word程序项目打开对应的word文档

         With DOC

            For Each mTable In .Tables  '循环文档中的各个表格

                  WordApp.Activate '激活word程序，使之窗体前置

                  mTable.Range.Copy '复制表格区域

                  With Windows(1)    '激活excel程序窗体，使之前置

                     .Activate

                     With ThisWorkbook.ActiveSheet '选中当前使用区A列下面的第一个单元格，并粘贴复制的word中的表格数据

                        .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1).Select

                        .Paste

                     End With

                  End With

            Next mTable

            .Close False '关闭word文档

         End With

      End If

Wend

Close #1 '关闭清单文件

If Dir(ThisWorkbook.Path & "\list.txt") <> "" Then Kill ThisWorkbook.Path & "\list.txt"    '删除清单文件

WordApp.Quit 'word程序项目关闭

Set DOC = Nothing '清空对应项目变量

Set WordApp = Nothing

End Sub

LMY123 · 发表于 2013-2-2 19:00

测试2.rar (62.79 KB, 下载次数: 347)

LMY123 · 发表于 2013-2-2 19:01

“求助说明”，是误传了，不用下载

湛蓝天空/mg · 发表于 2013-2-3 23:01

有创意学习了

4me · 发表于 2013-2-5 10:15

把多个word插入合并为同一个word文档，运行以下xls文档的宏，导入数据，要同时打开doc和xls.

130204.rar (29.61 KB, 下载次数: 322)

美髯客 · 发表于 2013-5-9 14:34

呵呵，学习，测试一下

banjinjiu · 发表于 2013-5-14 09:41

本帖最后由 banjinjiu 于 2013-5-14 09:45 编辑

LMY123 发表于 2013-2-2 19:00

请问把Word表格导入到excel时，表格很多，身份证及其它证件的长数字到excel里后，数据末尾后四位是0，还有数字前面有0的，请问怎么处理？我用的是你的代码，希望看到后能回复，不胜感谢！

		自动登录	找回密码
密码			免费注册

[求助] 求助关于word中多表格内容批量导入excel的问题