当前位置：首页 → 问答吧 → excel vba 如何检查word文档某段的内容

excel vba 如何检查word文档某段的内容

时间：2008-12-27

来源：互联网

想在excel的vba编写代码，完成如下功能：
检查某个目录下的所有word类型的文档是否包含标题“2.3.4.1 测试结论”和“2.3.4.2 测试说明”
如果没有，返回无；
如果有，返回“2.3.4.1 测试结论”和“2.3.4.2 测试说明”之间的内容。
请教如何写代码
非常感谢！！！

tmp.rar (35.69 KB)

[ 本帖最后由 sandwich 于 2009-1-4 08:47 编辑 ]

作者: sandwich 发布时间: 2008-12-27

可试试如下代码（包含“2.3.4.1  测试结论”字样就算有）：
Sub test()
Dim a As String, WdApp As Word.Application, myDoc As Word.Document
Dim i As Integer, myinfo As String, n As Integer, myRange As Word.Range
On Error Resume Next
ChDir "E:\"  '暂定测试路径
a = Dir("*.doc")
Set WdApp = CreateObject("Word.Application")
With WdApp
.ScreenUpdating = False
Do While a <> ""
      If a Like "[!~]*" Then
         Set myDoc = .Documents.Open(Filename:="E:\" & a, ConfirmConversions:=False, NoEncodingDialog:=True)
         i = i + 1
         myinfo = myinfo & i & vbTab & myDoc.Name & Chr(11)
         With myDoc.Content.Find
            .Text = "2.3.4.1  测试结论^p"
         If .Execute Then
            n = n + 1
            Set myRange = .Parent.Duplicate
            .Parent.SetRange .Parent.End, myDoc.Content.End
            If .Execute("2.3.4.2  测试说明^p") Then
                  myRange.End = .Parent.Start
            End If
            myinfo = myinfo & myRange
         Else
            myinfo = myinfo & "无" & vbCrLf
         End If
         End With
         myDoc.Close False
         a = Dir
      End If
Loop
.Visible = True
.Documents.Add.Content = myinfo
.ScreenUpdating = True
End With
Set WdApp = Nothing
MsgBox "共搜索到" & i & "个文档，其中包含标题“2.3.4.1  测试结论”的有" & n & "个。"
End Sub

[ 本帖最后由 sylun 于 2008-12-27 15:01 编辑 ]

作者: sylun 发布时间: 2008-12-27

WdApp As Word.Application
用户类型未定义
如何解决？
谢谢。

作者: sandwich 发布时间: 2008-12-29

在VBE工具菜单“引用”项列表选中引用相应的MicroSoft Word对象库

作者: sylun 发布时间: 2008-12-29

能否用代码实现这个引用？
谢谢。

作者: sandwich 发布时间: 2008-12-29

再请教一下：
Set WdApp = Nothing
之后，任务管理器中word应用程序仍然在，没有关闭。
如何才能关闭？
谢谢。

作者: sandwich 发布时间: 2008-12-29

再请教一下，这个程序从word中获得的内容，标题不包括在内
如： 2.3.4.1.1 2.3.4.1.2 等，有什么方法可以包括这些标题？
谢谢。

作者: sandwich 发布时间: 2008-12-30

引用:

原帖由 sandwich 于 2008-12-29 16:09 发表
再请教一下：
Set WdApp = Nothing
之后，任务管理器中word应用程序仍然在，没有关闭。
如何才能关闭？
谢谢。

用WdApp.Quit可退出当前的word，但因程序最后用word生成了查找记录，如关闭word则与此矛盾。

引用:

原帖由 sandwich 于 2008-12-30 16:34 发表
再请教一下，这个程序从word中获得的内容，标题不包括在内
如： 2.3.4.1.1 2.3.4.1.2 等，有什么方法可以包括这些标题？
谢谢。

不是很明白楼主的意思，能否举例说清楚一点，最好附有实际文档样本。实际word文档是否应用了多级自动编号？

作者: sylun 发布时间: 2008-12-31

实际word文档应用了多级自动编号，如2.3.4.1.1 2.3.4.1.2
这个程序从word中获得的内容，这些编号没有包括在内
有什么方法可以包括这些编号？
谢谢。

作者: sandwich 发布时间: 2009-01-01

可以试试在With myDoc.Content.Find这一行前面加上如下代码行：myDoc.Content.ListFormat.ConvertNumbersToText

作者: sylun 发布时间: 2009-01-01

我的代码是这样的，加上编号后，.Text 为 " 2.3.4.1  测试结论^p"，查找失败，if Execute 语句返回失败。如果 .Text 为 " 测试结论^p"，则返回成功。
应该如何修改代码？
谢谢！
            Set myDoc = .Documents.Open(Filename:=DirStr & "\" & a, ConfirmConversions:=False, NoEncodingDialog:=True)
            myDoc.Content.ListFormat.ConvertNumbersToText
            With myDoc.Content.Find
                  .Text = "2.3.4.1  测试结论^p"
                  If .Execute Then

作者: sandwich 发布时间: 2009-01-01

这次的问题也许出在查找的字符串上。因楼主没有提供文档样本，只能按楼主提供的文本查找。如实际文档中指定编号后面跟的不是两个半角空格，自然无法匹配。
楼主可检查实际文档中编号后面跟什么字符，再作相应改动，也可试试将查找字符代码修改为："2.3.4.1[^9^32　]@测试结论^p"，另一个查找代码也作相应改动。

作者: sylun 发布时间: 2009-01-01

With myDoc.Content.Find
.Text = "2.3.4.1 * 测试结论^p"
也查找失败。
如何编写代码能达到类似通配符的方法？

作者: sandwich 发布时间: 2009-01-01

忘了设置使用通配符。请将代码修改为：
With myDoc.Content.Find
.MatchWildcards = True
.Text = "2.3.4.1[^9^32　]@测试结论^13"

后一个.text字符串类似。

作者: sylun 发布时间: 2009-01-01

能否说明一下为什么是这样写？
.Text = "2.3.4.1[^9^32　]@测试结论^13"

而不用
.Text = "2.3.4.1*测试结论^13"

谢谢。

作者: sandwich 发布时间: 2009-01-03

还是不行啊。
不论.Text设置为什么，及时文档中不存在的字符，
If .Execute Then
都是返回true。

作者: sandwich 发布时间: 2009-01-03

不用星号*是因为它的匹配范围很广。当然你也可以用。
请楼主提供实际文档样本，否则我只能猜，这样讨论效率不高。

作者: sylun 发布时间: 2009-01-03

附件在第一个帖中，有两个文档，
需要提取测试结论和测试说明间的内容，
两篇文档的“4.4.6.1 测试结论” 中“4.4.6.1”和“测试结论”间据观察应该是tab字符和空格字符或两者的组合，
请帮忙看看如何写代码。
谢谢。

作者: sandwich 发布时间: 2009-01-04

可试试如下代码，经简单测试，对1楼附件可以通过。16楼所说的问题，估计是文件名出错所致，现在代码中添加了ChDrive语句，删除了错误处理语句。请设置好dirStr的值。
Sub test()
Dim dirStr As String, a As String, WdApp As Word.Application, myDoc As Word.Document
Dim i As Integer, myinfo As String, n As Integer, myRange As Word.Range
dirStr = "E:\"  '暂定测试路径
ChDrive dirStr
ChDir dirStr
a = Dir("*.doc")
Set WdApp = CreateObject("Word.Application")
With WdApp
.ScreenUpdating = False
Do While a <> ""
      If a Like "[!~]*" Then
         Set myDoc = .Documents.Open(Filename:=dirStr & a, ConfirmConversions:=False, NoEncodingDialog:=True)
         i = i + 1
         myinfo = myinfo & i & vbTab & myDoc.Name & Chr(11)
         myDoc.Content.ListFormat.ConvertNumbersToText
         With myDoc.Content.Find
            .MatchWildcards = True
            .Text = "4.4.6.1[^9^32　]@测试结论^13"
            If .Execute Then
                  n = n + 1
                  Set myRange = .Parent.Duplicate
                  .Parent.SetRange .Parent.End, myDoc.Content.End
                  If .Execute("4.4.6.2[^9^32　]@测试说明^13") Then
                     myRange.End = .Parent.Start
                  End If
                  myinfo = myinfo & myRange
            Else
                  myinfo = myinfo & "无" & vbCrLf
            End If
         End With
         myDoc.Close False
         a = Dir
      End If
Loop
.Visible = True
.Documents.Add.Content = myinfo
.ScreenUpdating = True
End With
Set WdApp = Nothing
MsgBox "共搜索到" & i & "个文档，其中包含标题“4.4.6.1  测试结论”的有" & n & "个。"
End Sub

[ 本帖最后由 sylun 于 2009-1-4 11:40 编辑 ]

作者: sylun 发布时间: 2009-01-04

谢谢。
再请教一下：
在VBE工具菜单“引用”项列表选中引用相应的MicroSoft Word对象库
能否用代码实现这个功能？

作者: sandwich 发布时间: 2009-01-04

If .Execute("4.4.6.2[^9^32　]@测试说明^13") Then

[^9^32　]是查找^9和^32之间的任意一个字符还是可以多个？
为什么后面加一个@？

谢谢。

作者: sandwich 发布时间: 2009-01-05

可以了，多谢sylun。

[ 本帖最后由 sandwich 于 2009-1-5 15:36 编辑 ]

作者: sandwich 发布时间: 2009-01-05

上面两帖的问题主要还是查找替换的通配符问题。建议楼主查看一下word帮助文件（不是VBE帮助文件）有关查找替换的相关解释，当中对每个通配符的含义以及^p与^13的用法都有说明。我想这些都是基础性的，弄不清楚就不好写代码。

[ 本帖最后由 sylun 于 2009-1-5 15:45 编辑 ]

作者: sylun 发布时间: 2009-01-05

为什么我的运行不了，提示：excel遇到一个错误，然后重启。

作者: yjm36 发布时间: 2011-06-12