在Word中使用.Find导致无限循环

我创build了一个Loop来查找一些HTML代码的每个迭代，并以电子邮件forms返回电子邮件数据。 我们正在寻找的是：

'Jibberish HTML Code <p><b><font color="#000066" size="3" face="Arial">Delivery has failed to these recipients or groups:</font></b></p> <font color="#000000" size="2" face="Tahoma"><p><a href="mailto:[e-mail]">[e-mail]</a><br> 'Jibberish HTML Code <p><b><font color="#000066" size="3" face="Arial">Delivery has failed to these recipients or groups:</font></b></p> <font color="#000000" size="2" face="Tahoma"><p><a href="mailto:[e-mail]">[e-mail]</a><br> 'Jibberish HTML Code <p><b><font color="#000066" size="3" face="Arial">Delivery has failed to these recipients or groups:</font></b></p> <font color="#000000" size="2" face="Tahoma"><p><a href="mailto:[e-mail]">[e-mail]</a><br> 

这段代码会find第一个迭代，而且现在循环会在第一个find的值上创build一个infite循环（不会移动到下一个find的值：

 Sub RevisedFindIt() ' Purpose: display the text between (but not including) ' the words "Title" and "Address" if they both appear. Dim rng1 As Range Dim rng2 As Range Dim strTheText As String Set rng1 = ActiveDocument.Range With rng1.Find .Execute FindText:="<font color=" & Chr(34) & "#000000" & Chr(34) & " size=" & Chr(34) & "2" & Chr(34) & " face=" & Chr(34) & "Tahoma" & Chr(34) & "><p><a href=" & Chr(34) & "mailto:", Forward:=True Do While .Found Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End) If rng2.Find.Execute(FindText:=Chr(34) & ">") Then strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text 'Debug.Print strTheText CreateObject("Excel.Application").Run "'TestExport.xlsm'!RunIt", strTheText End If Loop End With End Sub 

数据正被传递给Excel Sub：

 Public Sub RunIt(strTheText As String) Dim LastRow As Long Debug.Print strTheText & "Test" LastRow = ActiveWorkbook.ActiveSheet.Range("A" & ActiveWorkbook.ActiveSheet.Rows.Count).End(xlUp).Row + 1 ActiveWorkbook.ActiveSheet.Range("A" & LastRow).Value = strTheText End Sub 

如何让search跳到Word VBA中的下一个迭代？

Answer 1

通过更改rng1中间循环并重新提炼数据来解决：

 Sub RevisedFindIt() ' Purpose: display the text between (but not including) two strings Dim rng1 As Range Dim rng2 As Range Dim strTheText As String Set rng1 = ActiveDocument.Range Do With rng1.Find .Execute FindText:="<font color=" & Chr(34) & "#000000" & Chr(34) & " size=" & Chr(34) & "2" & Chr(34) & " face=" & Chr(34) & "Tahoma" & Chr(34) & "><p><a href=" & Chr(34) & "mailto:" If .Found Then Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End) If rng2.Find.Execute(FindText:=Chr(34) & ">") Then strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text 'Debug.Print strTheText CreateObject("Excel.Application").Run "'TestExport.xlsm'!RunIt", strTheText End If Set rng1 = ActiveDocument.Range(rng2.End, ActiveDocument.Range.End) Else Exit Do End If End With Loop End Sub 

Answer 2

事实上，你所需要的只是简单的：

 .execute 

在你之前

 End If 

Answer 3

你的问题看起来是因为rng1.Found的值一旦进入Do While .Found循环之后就不会改变。 .Found in Do While .Found指的是rng1.Found因为包含它的With rng1.Find语句。

Answer 4

 Sub M_snb() sn = Split(Replace(Join(Filter(Split(LCase(ActiveDocument.Content), Chr(34)), "mailto:"), "|"), "mailto:", ""), "|") With CreateObject("Excel.Application") .workbooks.Add().sheets(1).Cells(1).Resize(UBound(sn) + 1) = .Application.transpose(sn) .Visible = True End With End Sub