Question

我正在尝试遍历邮箱中的所有电子邮件，并从每个邮箱中提取附件。如果我没有包含删除，循环将按预期工作。如果包含删除，它适用于第一封电子邮件和＆＃34; next＆＃34;语句退出for循环，跳过剩余的电子邮件。我可以将删除分离到一个新循环，但这似乎效率低下。

For Each itm In Inbox.Items

  For Each objAtt In itm.Attachments

    sEmailDate = Format(itm.ReceivedTime, "dd/mm/yyyy")
    sDataDate = Format(DateAdd("d", -1, CDate(sEmailDate)), "dd/mm/yyyy")
    sFileName = objAtt.Filename
    sSubject = itm.Subject

    'Check if the report was sent today
    If sEmailDate = sTodayDate And sFileName = "Report.csv" Then
        bToday = True
    End If

    'Look for Report file
    If sFileName = "Report.csv" Then

        'Save it to the save folder, as the DisplayName. This will overwrite previously saved copies of this file
        objAtt.SaveAsFile saveFolder & "\" & "report" & sSubject & "_" & Format(sDataDate, "yyyymmdd") & ".csv"
        If Err.Number = 0 Then
            itm.Delete 'without this istwill loop correctly
            iReportCount = iReportCount + 1
        Else
            GoTo ExitLoop
        End If

    End If
  Next objAtt

Next itm

Answer 1

使用For循环代替For Each一个：

Dim items as Outlook.Items
Set items = Inbox.Items

For i = items.Count to 1 Step -1

  For Each objAtt In itm.Attachments

    sEmailDate = Format(itm.ReceivedTime, "dd/mm/yyyy")
    sDataDate = Format(DateAdd("d", -1, CDate(sEmailDate)), "dd/mm/yyyy")
    sFileName = objAtt.Filename
    sSubject = itm.Subject

    'Check if the report was sent today
    If sEmailDate = sTodayDate And sFileName = "Report.csv" Then
        bToday = True
    End If

    'Look for Report file
    If sFileName = "Report.csv" Then

        'Save it to the save folder, as the DisplayName. This will overwrite previously saved copies of this file
        objAtt.SaveAsFile saveFolder & "\" & "report" & sSubject & "_" & Format(sDataDate, "yyyymmdd") & ".csv"
        If Err.Number = 0 Then
            itm.Delete
            iReportCount = iReportCount + 1
        Else
            GoTo ExitLoop
        End If

    End If
  Next

Next

通过邮件项目循环但跳过电子邮件

1 个答案: