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

【问题标题】：Using .Find in Word Causes Infinite Loop在 Word 中使用 .Find 会导致无限循环
【发布时间】：2015-02-05 18:14:52
【问题描述】：

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

'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 子：

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 中的下一次迭代？

【问题讨论】：

您需要提供更多信息。它应该如何表现？什么时候应该“跳到下一次迭代”？既然rng1.Found 只执行一次，那么“下一次迭代”是什么？
@roryap 查看第一块“代码”，它更多是文档中的文本。查找应该跳转到匹配的每一行并返回电子邮件地址。它目前适用于文档中的第一个电子邮件地址，但不会继续前进。我不确定如何更改 rng1 以排除已找到并继续搜索文档的其余部分。
嘿@Chrismas007：你为什么不做一个正则表达式来获取电子邮件？
@JLILIAman 主要是因为我以前从未使用过它们，这种方法应该稍作调整。

标签： vba excel ms-word

【解决方案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

【讨论】：

起来！我的回答迟到了几秒钟:)

【解决方案2】：

其实你所需要的很简单：

.execute

在你唯一之前

End If

【讨论】：

【解决方案3】：

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

【讨论】：

这并没有真正给出解决方案，只是指出了问题。
@Chrismas007 -- 我不是要解决这个问题。问题是它为什么会发生。解决问题的方法有很多种。
问题是“如何让搜索跳到 Word VBA 中的下一个迭代？”
@Chrismas007 -- 好的，请耐心等待，我会提出一个解决方案。
@Chrismas007 -- 在你的问题下查看我的 cmets。

【解决方案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

【讨论】：