VBA code to display newest email with keyword in the subject

I'm working on a VBA code to display only the newest email with the keyword of a selected cell. All those emails (including the emails I sent or received from other people) are filed a specific outlook folder "Inbox/abc/def". Below are the codes I have come up with, but it only displays the oldest.

Sub DisplayNewestEmail()
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim fol As Outlook.Folder
Dim mi As Outlook.MailItem

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.Folders(1).Folders("Inbox").Folders("abc").Folders("def")

fol.Items.Sort "[ReceivedTime]", True

For Each mi In fol.Items
            If InStr(mi.Subject, ActiveCell.Value) > 0 Then
                mi.Display
                Exit Sub
            End If
Next mi
Set ol = Nothing
Set ns = Nothing
Set fol = Nothing

End Sub

I also have tried changing the code of fol.Items.Sort "[ReceivedTime]", True to fol.Items.Sort "[Received]", True or fol.Items.Sort "[ReceivedTime]", but it still only displays the oldest email.

Can someone please tell me how to display the newest email only? Many thanks

Solution

When you use the following code to sort items in the collection:

fol.Items.Sort "[ReceivedTime]", True

Your changes are not preserved when you get a new collection instance by using the following code:

For Each mi In fol.Items

If you want to preserve the sorting order when looping through items you need to declare an instance of the Outlook.Items class and use it for sorting and then looping over it. For example:

Dim itemsCollection as Outlook.Items

Set itemsCollection = fol.Items

itemsCollection.Sort "[ReceivedTime]", True

For Each mi In itemsCollection

But a better yet solution is to use the Find/FindNext or Restrict methods of the Items class to get items that correspond to the specified search criteria. Read more about these methods in the articles I wrote for the technical blog: