VBA Loop Through Emails in Folder in Order-CodePudding

I am trying to loop over the emails in folder, download the attachments and move the message to a folder labelled "processed." I want every email in the folder to the Processed folder and only keep the attachment from the most recent email. I figured the easiest way to do this would be to just loop through them all and have the most recent go last, overwriting the attachment each time.

Code Snippet Below

  oOlInbNo.Items.Sort "[ReceivedTime]", True
    
    Do While oOlInbNo.Items.count > 0
    
    For Each MailItem In oOlInbNo.Items
           For Each atch In MailItem.Attachments
                 If Right(atch.Filename, 3) = "xls" Then
                    atch.SaveAsFile NewFileNameNo
                 End If
            Next atch
                
        MailItem.Move oOlInbNo.Folders("Processed")
     Next MailItem
    Loop

However, when I run this it processes emails in this order

August 31 September 6 September 1 September 2

I cannot figure out why Sept 6 is going out of order.

CodePudding user response：

Sort items not folder.items.

Set oOlInbNoItems = oOlInbNo.items
oOlInbNoItems.Sort "[ReceivedTime]", True

You may have to switch from For Each to a reverse For Next.

Option Explicit

Private Sub MoveItems_OldestFirst()

Dim oOlInbNo As Folder
Dim oOlInbNoItems As items

Dim oOlItem As Object
Dim oOlMailitem As MailItem

Dim atch As Attachment

Dim i As Long

Set oOlInbNo = Session.GetDefaultFolder(olFolderInbox)
Set oOlInbNoItems = oOlInbNo.items

oOlInbNoItems.Sort "[ReceivedTime]", True

If oOlInbNoItems.Count > 0 Then

    For i = oOlInbNoItems.Count To 1 Step -1
        
        If oOlInbNoItems(i).Class = olMail Then
            
            Set oOlMailitem = oOlInbNoItems(i)
            For Each atch In oOlMailitem.Attachments
                If Right(atch.fileName, 3) = "xls" Then
                    atch.SaveAsFile NewFileNameNo
                End If
            Next atch
                
            'Debug.Print oOlMailitem.ReceivedTime
            
            oOlMailitem.Move oOlInbNo.Folders("Processed")
                
        End If
        
    Next

End If

End Sub

CodePudding user response：

Each time you call the Items property of Outlook folders you get a new Items collection with an individual sorting order. You need to deal with the same collection instance if you want to preserve the order.

Dim folderItems as Outlook.Items

Set folderItems = oOlInbNo.Items

folderItems.Sort "[ReceivedTime]", False
Do While folderItems.count > 0  
   If folderItems.Item(0).Class = olMail Then
      Set oOlMailitem = folderItems.Item(0)

As you can see there is no need to have two loops - you can use a single one instead.

I figured the easiest way to do this would be to just loop through them all and have the most recent go last, overwriting the attachment each time.

Looping through all items in the folder is not really a good idea. You may better process items in small bunches, so you could leave the Outlook UI responsive.

Also you may consider using the Find/FindNext or Restrict methods of the Items class helpful. For example, you could find recent items with attachments and process only them for saving attached files on the disk. Other items you can simply move to another folder if required.

Read more about these methods in the articles I wrote for the technical blog: