Question

我创建了一个循环来查找某些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>

此代码将找到第一次迭代，截至目前，Loop在第一个找到的值上创建一个infite循环（不会移动到下一个找到的值：

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

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

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

4 个答案: