Sort emails in Outlook 365 folder, and loop through them opening the oldest first

[netrixuser]

Any help given, as always, gratefully received....
I have the code below that loops through any unread emails in a certain folder and imports the attached csv file into a Workbook.
My issue is in trying to get the code to open the oldest unread email first, followed by next oldest etc. At the moment the code appears to be a tad random in which email it opens first.

To test I have 5 emails in the referenced email folder beneath the Inbox, with dates and times as in the table below: [The emails are currently sorted by attachment size]
When the code runs it selects the email sent on Friday 4th August first, which is neither the oldest or the newest, nor the first or the last in the folder. If I have the email folder sorted by date, the code selects the newest email first - and I want the exact opposite.

Wed 09/08/2023 03:47

Fri 04/08/2023 04:28

Tue 08/08/2023 22:24

Thu 03/08/2023 05:03

Thu 03/08/2023 11:34

I added this small piece of code below, just before the Loop "For each AlertEmail in Folder.ITems" but it made no difference, set to True or False

Dim Items As Object

    Set Items = Folder.Items
    Items.Sort "Receivedtime", True


For Each AlertEmail In Folder.Items

Main Code

Sub TESTGetEmailFromOutlook()
' Need References added for Microsoft Outlook Object Library and
' "Microsoft Shell Controls And Automation"
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder   'variable to store the name of the Outlook folder
Dim Alertemail As Variant
Dim OutlookAtch As Object
Dim NewFileName As String
Dim OutlookSent As Variant
Dim lastRow As Integer   'variable used to increment row by 1 when refreshing the query
    lastRow = 1
Const AlertemailSenderAddress = "no-reply@abc123.com"
Const AlertemailSubjectKey = "Missing Recording Alerts Update"

Dim shell As Shell32.shell
Dim DestinationFolder As Shell32.Folder
Dim SourceFolder As Shell32.Folder

    'Configure Paths for zip files on disk
    Set shell = New Shell32.shell
    Dim AttachmentDestinationFolder As Variant

    AttachmentDestinationFolder = "C:\Temp\UnzippedAttachments" 
    Set DestinationFolder = shell.Namespace(AttachmentDestinationFolder)
    
    'check for Attachment Destination Folder
    If Dir(AttachmentDestinationFolder, vbDirectory) = "" Then
        MsgBox "Destination folder not found, please create: " & AttachmentDestinationFolder, vbExclamation, "Exit"
        Exit Sub
    End If
    
Dim AttachmentSourceFileName As String 'variable to store the name of the zipped file
AttachmentSourceFileName = "c:\Temp\Attachments\log.zip" 'set the variable to Path:Log.zip
    
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Dim SharedMailbox As Object 'variable to store name of Outlook folder
Dim MailFolder As Object

Dim OutlookNS As Outlook.Namespace
    Set OutlookNS = OutlookApp.GetNamespace("MAPI")
    OutlookNS.Logon
    Set SharedMailbox = OutlookNS.CreateRecipient("SharedMail@ABC.com") 'store Outlook folder as the Variable "SharedMailbox"
    SharedMailbox.Resolve
    
    'if the ShareMailbox name exists, store the name of the Outlook folder as the Variable "Folder"
    If SharedMailbox.Resolved Then

        Set Folder = OutlookNS.GetSharedDefaultFolder(SharedMailbox, olFolderInbox).Folders("New Alerts")
    End If

    'if Outlook folder is empty - display message and end code
    If Folder.UnReadItemCount = 0 Then
        MsgBox ("There are no Unread Emails - The script will now end"), vbExclamation
    End
    End If
    
Dim UnredEmailCnt As Integer 'variable to store number of unread emails in Oulook folder
    
    'if unread emails, count and display number
    If Folder.UnReadItemCount > 0 Then
        UnredEmailCnt = Folder.UnReadItemCount
        MsgBox "Found " & UnredEmailCnt & " matching Alert E-mail(s)"
    End If
    
Dim EmailSubject As String 'variable to store email subject
Dim EmailSenderEmailAddress As String 'variable to store email senders address


For Each Alertemail In Folder.Items
    
EmailSubject = LCase(Alertemail.Subject) 'assign value to variable
EmailSenderEmailAddress = LCase(Alertemail.SenderEmailAddress) 'assign value to variable


    If ((StrComp(EmailSenderEmailAddress, AlertemailSenderAddress, vbTextCompare) = 0) And InStr(1, EmailSubject, LCase(AlertemailSubjectKey), vbTextCompare)) Then
        If Alertemail.UnRead = True Then
      
                Alertemail.Attachments.Item(1).SaveAsFile (AttachmentSourceFileName)        'Save zipped attachment to Attachments folder
                Set SourceFolder = shell.Namespace(AttachmentSourceFileName)                   'set the source file name to path:Log.zip
                DestinationFolder.CopyHere SourceFolder.Items                                '??? UnZip File and save csv file to Unzipped Attachments Folder
            
                Alertemail.UnRead = False 'set email to read - needed if deleting on next line ???
                'Alertemail.Delete         'delete email
                
                Dim oFSO As Object
                Dim oFolder As Object
                Dim oFile As Object
            
                Set oFSO = CreateObject("Scripting.FileSystemObject")
                Set oFolder = oFSO.GetFolder(AttachmentDestinationFolder) 'folder where attachment (csv) file is temp stored
                        
                For Each oFile In oFolder.Files  'for loop - not really necessary as only one csv file in the folder at any one time ??
                    FileName = oFile.Path
                                 
                'store the unique number from the filename in the Resource Sheet
                fname = Left(Right(FileName, 18), 14)
                Sheets("Resource Sheet").Range("S1").Value = fname
                Sheets("resource sheet").Range("S1").Copy
                Sheets("resource sheet").Range("T1").Insert Shift:=xlDown
                    With Sheets("resource sheet").Range("AT1").End(xlDown)
                        Sheets("resource sheet").Range("U1").Value = Application.WorksheetFunction.CountIf(Range("T1", Range("T1").End(xlDown)), ">1")
                    End With
                Exit For
                    
                    Next oFile

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Scratch Sheet")
On Error Resume Next
                    With ws.QueryTables.Add(Connection:="TEXT;" & FileName, _
                            Destination:=ws.Range("A" & lastRow))
                         .TextFileParseType = xlDelimited
                         .TextFileCommaDelimiter = True
                         '.TextFileStartRow = 2
                         .Refresh
                    End With
                                  
                Kill (FileName) 'delete file from AttachmentDestinationFolder
                'Call DeleteExisting 'new attachment will have existing alerts - delete these
                'Call CopyNew 'copy new alerts from Scratch Sheet to Current Alerts sheet
                'Call RemClosed ' remove alerts from Current Alerts that are CLOSED in Scratch Sheet
                        
        End If
    End If
               
Next Alertemail 

'Set MailFolder = Nothing
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
Set shell = Nothing
Set DestinationFolder = Nothing
Set OutlookNS = Nothing
Set SourceFolder = Nothing
Set oFSO = Nothing
Set oFolder = Nothing
Set ws = Nothing
Set SharedMailbox = Nothing

End Sub

 

[John_w]

I added this small piece of code below, just before the Loop "For each AlertEmail in Folder.ITems" but it made no difference, set to True or False

Dim Items As Object

Set Items = Folder.Items
Items.Sort "Receivedtime", True


For Each AlertEmail In Folder.Items

Because you're still looping through Folder.Items, when it should be Items.Items. But use a different variable name, not Items, and restrict the new items collection to unread emails:

    Dim unreadItems As Object
    
    Set unreadItems = Folder.Items.Restrict("[Unread]=True")
    unreadItems.Sort "[ReceivedTime]", Descending:=False  'ascending time order - oldest to newest
    
    For Each AlertEmail In unreadItems.Items

and now you don't need the If Alertemail.UnRead = True Then statement inside the loop.

 

[netrixuser]

Because you're still looping through Folder.Items, when it should be Items.Items. But use a different variable name, not Items, and restrict the new items collection to unread emails:

    Dim unreadItems As Object
   
    Set unreadItems = Folder.Items.Restrict("[Unread]=True")
    unreadItems.Sort "[ReceivedTime]", Descending:=False  'ascending time order - oldest to newest
   
    For Each AlertEmail In unreadItems.Items

and now you don't need the If Alertemail.UnRead = True Then statement inside the loop.

Many thanks for your reply John_W - apologies for not replying sooner, I am fortunate to only work Mon to Weds
I changed my code and remarked out the If statement in the loop as you suggested. The new code Compiles without error but throws an error code 406 "Object doesn't support named arguments" at this line:

 unreadItems.Sort "[ReceivedTime]", Descending:=False  'ascending time order - oldest to newest

New Code:

Dim EmailSubject As String 'variable to store email subject
Dim EmailSenderEmailAddress As String 'variable to store email senders address


    Dim unreadItems As Object
    
    Set unreadItems = Folder.Items.Restrict("[Unread]=True")
    unreadItems.Sort "[ReceivedTime]", Descending:=False  'ascending time order - oldest to newest
    
    For Each AlertEmail In unreadItems.Items

'For Each Alertemail In Folder.Items
    
EmailSubject = LCase(Alertemail.Subject) 'assign value to variable
EmailSenderEmailAddress = LCase(Alertemail.SenderEmailAddress) 'assign value to variable


    If ((StrComp(EmailSenderEmailAddress, AlertemailSenderAddress, vbTextCompare) = 0) And InStr(1, EmailSubject, LCase(AlertemailSubjectKey), vbTextCompare)) Then
        'If Alertemail.UnRead = True Then
      
                Alertemail.Attachments.Item(1).SaveAsFile (AttachmentSourceFileName)        'Save zipped attachment to Attachments folder
                Set SourceFolder = shell.Namespace(AttachmentSourceFileName)                   'set the source file name to path:Log.zip
                DestinationFolder.CopyHere SourceFolder.Items                                '??? UnZip File and save csv file to Unzipped Attachments Folder
            
                Alertemail.UnRead = False 'set email to read - needed if deleting on next line ???
                'Alertemail.Delete         'delete email
                
                Dim oFSO As Object
                Dim oFolder As Object

 

[John_w]

I changed my code and remarked out the If statement in the loop as you suggested. The new code Compiles without error but throws an error code 406 "Object doesn't support named arguments" at this line:

unreadItems.Sort "[ReceivedTime]", Descending:=False 'ascending time order - oldest to newest

Just remove the argument name:

unreadItems.Sort "[ReceivedTime]", False 'ascending time order - oldest to newest

 

[netrixuser]

You are a star John_W! thank you again.

I had to remove the .items from this line for it to work - [I find the Microsoft Help files for all VBA errors so hard to decipher !]

For Each AlertEmail In unreadItems.Items

I'm not sure how this site fully works - I would like to mark your reply as the answer, but I have another request - and not sure if I should start a new thread or mention here - so I'll mention here first !!!

I did have the line

Alertemail.Delete

Within the For Each Alertemail loop, but it messed with the loop, as the number "stored" for the "for each" bit had changed when the loop came to the Next Alertemail line - and the code moved on rather than looping.
After I have run the code over the unread emails I would like to delete those emails, I am just not sure on the process now - thinking I would have to store the details of each email as I process it as a Variable (date/time etc) and then delete after the loop has finished, but in practice there could be around 10 emails to process and I cannot see a way to incorporate the delete command....

 

[John_w]

but I have another request - and not sure if I should start a new thread or mention here

You might as well stay in this thread, as it's part of the same macro.

I did have the line

Alertemail.Delete

Within the For Each Alertemail loop, but it messed with the loop, as the number "stored" for the "for each" bit had changed when the loop came to the Next Alertemail line - and the code moved on rather than looping.

In my tests, each execution of Alertemail.UnRead = False inside the loop removes Alertemail from the unreadItems collection, which also affects looping through the unread emails. It seems that the unreadItems object maintains the restrict criterion previously defined by Set unreadItems = Folder.Items.Restrict("[Unread]=True"). Therefore you should delete Alertemail.UnRead = False.

Use a separate loop to delete the emails, looping backwards:

    Dim i As Long
    For i = unreadItems.Count To 1 Step -1
        EmailSubject = unreadItems(i).subject
        EmailSenderEmailAddress = unreadItems(i).SenderEmailAddress
        If StrComp(EmailSenderEmailAddress, AlertemailSenderAddress, vbTextCompare) = 0 And InStr(1, EmailSubject, AlertemailSubjectKey, vbTextCompare) Then
            unreadItems(i).Delete
        End If
    Next

 

[netrixuser]

I can't thank you enough John_W, I am pretty chuffed at where I got with my code, with very little programming knowledge and a lot of Googling, but I would never have worked out these last two pieces that you helped me with.

Thank you for your time, very much appreciated !!

Regards

Netrix

 

[John_w]

Thanks for your feedback - glad it's all working.

The thing with Restrict("[Unread]=True") and UnRead = False removing items from the collection is a new discovery for me, so it was useful to learn something new whilst helping you.