在 Word 中使用 .Find 会导致死循环

Question

我创建了一个循环来查找某些 HTML 代码的每次迭代和 return 电子邮件数据作为字符串。我们正在寻找的是：

'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:last.first@location.company.com">last.first@location.company.com</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:last.first@location.company.com">last.first@location.company.com</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:last.first@location.company.com">last.first@location.company.com</a><br>

此代码将找到第一个迭代，并且从现在开始，循环在第一个找到的值上创建一个无限循环（不会移动到下一个找到的值：

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

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

Answer 1

您的问题看起来是因为一旦进入 Do While .Found 循环，rng1.Found 的值就永远不会改变。 Do While .Found 中的 .Found 引用 rng1.Found 因为包含它的 With rng1.Find 语句。

Answer 2

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

Answer 3

通过更改 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 4

其实你需要的很简单：

.execute

在你唯一的

之前

End If

在 Word 中使用 .Find 会导致死循环

Using .Find in Word Causes Infinite Loop

excel

vba

ms-word