Return one newest instance of the mail, based on subject, from multiple subfolders

Question

I have a search for items, in subfolders of the Inbox, based on subject line.

I am trying to return the most recent mail and have been using the code:

Items.Sort "[ReceivedTime]", True

I also tried CreationTime and SentOn in between the brackets.

The search returns mails with the same subject line in the following order:

9/23/2016 9:31 AM
10/19/2016 12:57 PM
9/29/2016 10:54 AM

My code:

Dim Fldr As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim olMail As Variant

Set oOLapp = CreateObject("Outlook.application")
Set olNs = oOLapp.GetNamespace("MAPI")

For step = 1 To MaxCount 
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

    For Each Fldr in Fldr.Folders
        Set Items = Fldr.Items
        Items.Sort "[ReceivedTime]", True

            For Each olMail in Items 
                If InStr(olMail.Subject, "Text" & Cstr(step))
                    olMail.Display Then 
                    Set Msg = oOLapp.CreateItem(olMailItem)
                    .Attachments.Add olMail, olEmbeddeditem
                    Set Msg = Nothing
                End If 
            Next 
    Next 
Next

I want the one newest instance of the mail.

---

I also tried the code below where people seem to have the most success when trying to retrieve the most recent code.

I get

Error404 "Array index out of bounds"

For step = 1 To MaxCount 
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

    For i = Fldr.Folders.Count To 1 Step -1
        Set Fldr = Fldr.Folders(i)
            For a = Fldr.Items.Count To 1 Step - 1
                Set olMail = Fldr.Items(a)
                //Search and attachment code. See previous code
            Next 
        Next 
    Next

---

RESULT:
My code pulls the mail in sequential order based on the folders it looks in. So the mail with the earliest time stamps went into a folder that appeared before the other mail so that is why my code kept pulling the earliest one instead of the latest one.

Answer 1

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub AdvSearchForStr()

    Dim strSearch As String
    Dim rsts As Results
    
    Dim i As Long
    Dim rstObj As Object
    Dim myMsg As MailItem
    
    strSearch = "Test"

    Dim strFilter As String
    strFilter = "urn:schemas:httpmail:subject LIKE '%" & strSearch & "%'"
    Debug.Print strFilter

    Dim strScope As String
    'strScope = "'Inbox', 'Sent Items', 'Tasks'"
    strScope = "'Inbox'"

    Dim objSearch As Search
    Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="SearchFolder")

    'Save the search results to a searchfolder
    'objSearch.Save (strSearch)
    
    ' Delay to allow search to complete
    ' The Application.AdvancedSearchComplete event appears to be broken
    '  https://docs.microsoft.com/en-us/office/vba/api/outlook.application.advancedsearchcomplete
    Dim waitTime As Long
    Dim delay As Date
    
    waitTime = 1    ' in seconds - adjust as needed
    Debug.Print vbCr & "Wait start: " & Now
        
    delay = DateAdd("s", waitTime, Now)
    Debug.Print "Wait until: " & delay
        
    Do Until Now > delay
        DoEvents
    Loop

    Set rsts = objSearch.Results
    Debug.Print " rsts.Count: " & rsts.Count
    
    If rsts.Count > 0 Then
        
        rsts.Sort "[ReceivedTime]", True
        Set rstObj = rsts(1)
        rstObj.Display
        
        Set myMsg = CreateItem(olMailItem)
        myMsg.Attachments.Add rstObj, olEmbeddeditem
        myMsg.Display
    
    Else
    
        Debug.Print "no mail found."
        
    End If

End Sub

Answer 2

I had no problem running the following script in - all the messages are in the expected order - from older to newest. Did you mean to sort newest to oldest?

set folder = Application.ActiveExplorer.CurrentFolder
set items = folder.Items
items.Sort "[ReceivedTime]", False
For Each msg in items
  Debug.Print msg.ReceivedTime & "  " & msg.Subject
next