0

I am trying to loop through all emails in a mailbox and extract the attachment from each. The loop works as expected if I don't have the delete included. With the delete included it works for the first email and on the "next" statement exits the for loop, skipping the remaining email. I could separate out the delete to a new loop but that seems inefficient.

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
Community
  • 1
  • 1
Snayff
  • 97
  • 10
  • So try `For i = itm.Count to 1 Step -1` instead of `For Each itm In Inbox.Items`. After defining `itm` as `Inbox.Items`. Im not sure if the syntax is right but the problem with the `For Each`-Loop and Delete is, that it will delete the items, so they will shift and it cant correctly keep track of the items. thats why you need to go trough backwards. – Plagon Jul 10 '17 at 09:19
  • Possible duplicate of [For Each loop: Some items get skipped when looping through Outlook mailbox to delete items](https://stackoverflow.com/questions/10725068/for-each-loop-some-items-get-skipped-when-looping-through-outlook-mailbox-to-de) – niton Nov 03 '17 at 03:12

1 Answers1

0

Use the For loop instead of For Each one:

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
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45