'For Each' 循环不断循环过去的 'If' 条件

Question

我正在使用 VBA 将电子邮件从 Outlook 提取到 Excel 中，将电子邮件的主题行与另一张工作表上的一系列单元格进行比较。我正在使用 For Each 循环来实现这一点，但似乎当我的 if 条件满足时，它会继续运行，所以它不会发布我想要的结果。它似乎遍历了我定义的范围内的所有单元格，但即使它满足我的 if 条件，它也会继续运行并最终变为空白。

我在这里定义我的范围：

Dim rRng As Range, cel As Range
Set rRng = Sheet2.Range("A2:A1218")

这是我的 For Each 循环：

oRow = 1
    For iRow = 1 To Folder.Items.Count 'This loops through the inbox items.
        If VBA.DateValue(VBA.Now) - 1 <= VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) And VBA.DateValue(VBA.Now) > VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) Then 'This is checking that the emails were received within a certain time frame.
            For i = 0 To UBound(emails) 
                If StrComp(Folder.Items.Item(iRow).SenderEmailAddress, emails(i)) = 0 Then 'This is checking that the emails are coming from specific address', emails is an array of accepted address'.
                    For Each cel In rRng.Cells 'The beggining of my for each
                        If InStr(1, Folder.Items.Item(iRow).Subject, cel.Text) > 0 Then 'checking to see if my the content from one of the cells in the range is part of the subject from the emails.
                             ThisWorkbook.Sheets(1).Cells(oRow, 3) = cel.Value 'If it is part of the subject, take the value from the cell in the range where it matches, and put that value in another cell.
                        End If
                    Next cel
                    oRow = oRow + 1
                    ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
                    ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).ReceivedTime
                    ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
                    ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Subject
                    ThisWorkbook.Sheets(1).Cells(oRow, 7) = Folder.Items.Item(iRow).Body
                    'All of this above code is inserting data from the emails into cells.
                End If
            Next i
        End If
    Next iRow

oRow 是 Excel 工作表中行的计数器。

iRow 是电子邮件项目的计数器。

还有更好的方法吗？

Answer 1

EDIT2：还是有点猜……

Dim itm As Object '<<< this makes your code more readable...
Dim rw as range

Set rw = ThisWorkbook.Sheets(1).Rows(1)

For iRow = 1 To Folder.Items.Count

    Set itm = Folder.Items.Item(iRow)

    If Now - 1 <= itm.ReceivedTime Then
        For i = 0 To UBound(emails)
            If StrComp(itm.SenderEmailAddress, emails(i)) = 0 Then

                For Each cel In rRng.Cells
                    If InStr(1, itm.Subject, cel.Text) > 0 Then
                        rw.Cells(3).Value = cel.Value  
                        Exit For 'exit loop over cells
                    End If 'subject match
                Next cel
                'record the other details
                rw.Cells(1).Value = itm.ReceivedTime
                rw.Cells(5).Value = itm.SenderEmailAddress
                rw.Cells(6).Value = itm.Subject
                rw.Cells(7).Value = itm.Body
                Set rw = rw.Offset(1, 0)
                Exit For 'exit loop over emails
           End If 'email match
        Next i
    End If
Next iRow