如何批量提取word中的标题及正文到excel表中

dogseye · 发表于 2017-9-22 19:10

需求说明

1、可批量将文件夹内的所有word文档中的一级标题、二级标题及正文提取出来，并按结果示例1l格式展示；
2、对于正文中的图片，可批量将图片重命名后，存储在制定文件夹下。图片命名规则为：
a、正文中只有1张图：图片正文所属标题名+图1
a、正文中只有N张图：图片正文所属标题名+图1；图片正文所属标题名+图2；图片正文所属标题名+图4；…

附1：word文档示例

附2：excel转换结果1示例

附2：excel转换结果2示例

批量提取word中标题及正文到excle示例文档.zip (20.53 KB, 下载次数: 159)

Excel结果示例.zip (10.08 KB, 下载次数: 90)

dogseye · 发表于 2017-9-22 21:47

各位大神，有什么办法可以做到吗？

小花鹿 · 发表于 2017-9-22 21:51

提取word到excel 例子很多，搜索一下..............................................................................

duquancai · 发表于 2017-9-22 21:52

这种题目，能得到代码的可能性极小极小。

dogseye · 发表于 2017-9-22 21:54

duquancai 发表于 2017-9-22 21:52
这种题目，能得到代码的可能性极小极小。

怎么样，才可以解决这个问题呢

duquancai · 发表于 2017-9-22 21:56

本帖最后由 duquancai 于 2017-9-22 22:04 编辑

dogseye 发表于 2017-9-22 21:54
怎么样，才可以解决这个问题呢

没有人愿意写这么复杂的代码。。。。。。。因为这个题目非常考查WordVBA的知识，所以我说你能得到代码的可能性极小极小！！！

QQ214189912 · 发表于 2017-9-23 09:54

Paragraphs.Style

dogseye · 发表于 2017-9-23 14:27

多谢各位，快搞定了。搞定后把代码发出来

xuejiebo · 发表于 2017-9-29 11:35

Sub 提取二级标题的内容()
Dim br(1 To 100, 1 To 3)
With CreateObject("shell.application")
Set my = .browseforfolder(0, "getfolder", 0, 0)
If Not my Is Nothing Then mypath = my.self.Path Else Exit Sub
End With
With CreateObject("wscript.shell")
ar = Split(.exec("cmd /c dir /a-d /b " & Chr(34) & mypath & Chr(34)).stdout.readall, vbCrLf)
ar = Filter(ar, "doc")
For q = 0 To UBound(ar)
Set doc = GetObject(mypath & "" & ar(q))
s = s & doc.Range.Text
doc.Close
Next
End With
For i = 8 To 13
s = Replace(s, Chr(i), "") & "标题"
Next
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(\d{4})([\s\S]+?)标题"
Set mat = .Execute(s)
For i = 0 To mat.Count - 1
n = n + 1
br(n, 1) = "标题" & Left(mat(i).submatches(0), 2)
br(n, 2) = "标题" & mat(i).submatches(0)
br(n, 3) = mat(i).submatches(1)
Next
End With
[a3].Resize(n, 3) = ""
[a3].Resize(n, 3) = br
End Sub

复制代码

xuejiebo · 发表于 2017-9-29 11:36

就第一问的。第二问的按标题取图片有点变态弄不出来，你要是有方法弄可以分享一下。

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

[求助] 如何批量提取word中的标题及正文到excel表中