For each cycle: some items are skipped when going through an Outlook mailbox to delete items

Question

I wanted to develop VBA code that:

• Scrolls all the email items in the inbox
• If there are any other items, say "Calendar Invitation" skips this item.
• Detects emails with attachments
• If the attached file has the extension ".xml" and a specific title in it, it saves it in the directory if it does not continue the search
• Putting all the e-mail includes the attached .xml files in the "Deleted Items" folder after completing step 4 and deletes all the e-mails in this folder by looping.

The code works fine EXCEPT; for example

• Your inbox contains 8 e-mail messages with a ".xml" file attached to each of them.
• run the code
• You will see that only 4 out of 8 elements are successfully processed, the remaining 4 remain in their positions.
• If you run the code again, 2 elements will be successfully processed now, and the remaining 2 will remain in your mailbox.

Problem: after running the code, it should process all the files and delete not half of them in each run. I want it to process all the elements in one pass.

By the way, this code runs every time I open Outlook.

Private Sub Application_Startup() 'Initializing Application_Startup forces the macros to be accessible from other offic apps 'Process XML emails Dim InboxMsg As Object Dim DeletedItems As Outlook.Folder Dim MsgAttachment As Outlook.Attachment Dim ns As Outlook.NameSpace Dim Inbox As Outlook.Folder Dim fPathTemp As String Dim fPathXML_SEM As String Dim fPathEmail_SEM As String Dim i As Long Dim xmlDoc As New MSXML2.DOMDocument60 Dim xmlTitle As MSXML2.IXMLDOMNode Dim xmlSupNum As MSXML2.IXMLDOMNode 'Specify the folder where the attachments will be saved fPathTemp = "some directory, doesn't matter" fPathXML_SEM = "some directory, doesn't matter" fPathEmail_SEM = "some directory, doesn't matter" 'Setup Outlook Set ns = GetNamespace("MAPI") Set Inbox = ns.Folders.Item("mailbox-name").Folders("Inbox") Set DeletedItems = ns.Folders.Item("mailbox-name").Folders("Deleted Items") 'Loop through all Items in Inbox, find the xml attachements and process if they are the matching reponses 'On Error Resume Next For Each InboxMsg In Inbox.Items If InboxMsg.Class = olMail Then 'if it is a mail item 'Check for xml attachement For Each MsgAttachment In InboxMsg.Attachments If Right(MsgAttachment.DisplayName, 3) = "xml" Then 'Load XML and test for the title of the file MsgAttachment.SaveAsFile fPathTemp & MsgAttachment.FileName xmlDoc.Load fPathTemp & MsgAttachment.FileName Set xmlTitle = xmlDoc.SelectSingleNode("//title") Select Case xmlTitle.Text Case "specific title" 'Get supplier number Set xmlSupNum = xmlDoc.SelectSingleNode("//supplierNum") 'Save the XML to the correct folder MsgAttachment.SaveAsFile fPathXML_SEM & xmlSupNum.Text & "_" & Format(Date, "yyyy-mm-dd") & ".xml" 'Save the email to the correct folder InboxMsg.SaveAs fPathEmail_SEM & xmlSupNum.Text & "_" & Format(Date, "yyyy-mm-dd") & ".msg" 'Delete the message InboxMsg.Move DeletedItems Case Else End Select 'Delete the temp file On Error Resume Next Kill fPathTemp & MsgAttachment.FileName On Error GoTo 0 'Unload xmldoc Set xmlDoc = Nothing Set xmlTitle = Nothing Set xmlSupNum = Nothing End If Next End If Next 'Loop through deleted items and delete For Each InboxMsg In DeletedItems.Items InboxMsg.Delete Next 'Clean-up Set InboxMsg = Nothing Set DeletedItems = Nothing Set MsgAttachment = Nothing Set ns = Nothing Set Inbox = Nothing i = 0 End Sub 

Answer 1

Probable reason: when you do this InboxMsg.Move , all the messages in your mailbox after the one that was moved are typed in one position in the list. Thus, you end up missing some of them. This is a major annoyance with the VBA For Each construct (and it doesn't seem to be consistent).

Possible Solution: Replace

 For Each InboxMsg In Inbox.Items 

from

 For i = Inbox.Items.Count To 1 Step -1 'Iterates from the end backwards Set InboxMsg = Inbox.Items(i) 

This way you go back from the end of the list. When you move a message to deleted items, then it doesn’t matter when the next items in the list are typed onto it, because you processed them anyway.

Answer 2

It is often impractical to change the contents of (under) a set of elements, moving along them. You can change your code so that it first identifies all the elements that need to be processed and adds them to the Collection . Then process all the elements in this collection.

Basically, you should not delete items from your inbox when you view content. First, collect all the elements you want to process (in the Inbox loop), and then, when you finish the loop, process this set of elements.

Here is some kind of pseudo code that demonstrates this:

 Private Sub Application_Startup() Dim collItems As New Collection 'Start by identifying messages of interest and add them to a collection For Each InboxMsg In Inbox.Items If InboxMsg.Class = olMail Then 'if it is a mail item For Each MsgAttachment In InboxMsg.Attachments If Right(MsgAttachment.DisplayName, 3) = "xml" Then collItems.Add InboxMsg Exit For End If Next End If Next 'now deal with the identified messages For Each InboxMsg In collItems ProcessMessage InboxMsg Next InboxMsg 'Loop through deleted items and delete For Each InboxMsg In DeletedItems.Items InboxMsg.Delete Next End Sub Sub ProcessMessage(InboxMsg As Object) 'deal with attachment(s) and delete message End Sub