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

＆＃39; For Each＆＃39;循环保持循环过去＆＃39;如果＆＃39;条件

1 个答案: