作者：绿色风
分类：
时间：2022-08-17
浏览：167
楼主
kevinchengcw |
Q: 如何用vba代码批量复制指定位置的全部word文档中的表格到excel的一个工作表中？
A: 提供一种类似手工交互的方式完成的代码：
- 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
|
2楼
7786910 |
学了一招 |
3楼
kszcs |
收藏起来。学学K版 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一