如何在word中 搜索到所有的关键字并复制关键字后的若干字符？

fhesuiwk

如何在word中 搜索到所有的关键字并复制关键字后的若干字符？
我想复制这个文档中所有的 Job no.: 后面的门窗代号 ，并写入一个excel文档中，怎么通过VBA实现？

duquancai

可以用查找并提取。

fhesuiwk

duquancai 发表于 2016-12-13 19:32
可以用查找并提取。

关键是 我所查找的关键字是一定的  而关键字后面的字符不一定  这个代码具体要怎么写呢？求教

duquancai

fhesuiwk 发表于 2016-12-14 08:37
关键是 我所查找的关键字是一定的  而关键字后面的字符不一定  这个代码具体要怎么写呢？求教

提供思路了啊！至于代码具体要怎么写，可能您自己得动手写了。

小花鹿

用正则也可以.............................................................................................................

小花鹿

给你一段代码，自己修改一下：
Sub test()
Dim myword, thispath, mydoc, s, s1, tm, r&
Set myword = CreateObject("word.application")
myword.Visible = True
thispath = ThisWorkbook.Path & "\"
mydoc = Dir(thispath & "*.doc")
Do While mydoc <> ""
    r = r + 1
    With myword
        .documents.Open thispath & mydoc
        .Selection.Find.MatchWildcards = True
         s = "": s1 = ""
        If .Selection.Find.Execute(s & "*" & s1) Then
            tm = .Selection.Text
            tm = Replace(Replace(Replace(tm, s, ""), " ", ""), Chr(13), "")
            Cells(r + 2, 1) = tm: tm = ""
            .Selection.MoveRight Unit:=1, Count:=1
        End If        
        .documents.Close False
    End With
    mydoc = Dir
Loop
myword.Quit
End Sub