Excel VBA Outlook search Multiple Criteria (ID and Date) - vba

Question

This code was derived from Excel VBA for searching in mails of Outlook.
I made adjustments to make it search a SharedMailbox which does work but the issue is that the mailbox is receiving hundreds of emails a day which makes searching time a bit longer for my liking (we have emails from early last year even). I would like to impose a 2nd search criteria, this time a date limit, like only search emails that are 2 to 3 days old.
Here is what I got:
Dim outlookapp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim projIDsearch As String
Dim myRecipient As Outlook.Recipient
Dim days2ago As Date
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("SharedMailboxName")
myRecipient.Resolve
'Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("x")
Set Fldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set myTasks = Fldr.Items
projIDsearch = ActiveCell.Cells(1, 4)
days2ago = DateTime.Now - 3
For Each olMail In myTasks
'If olMail.ReceivedTime > days2ago Then
If (InStr(1, olMail.Subject, projIDsearch, vbTextCompare) > 0) Then
olMail.Display
'Exit For
End If
Next
I've looked around and found the .ReceivedTime property, which sounds like the thing that I need but I'm having a struggle on how to incorporate it into the code.
Actually I don't even know how a Variant(olMail) is able to accept the .display method and .subject property.
These are the codes that I've added but they don't seem to work:
days2ago = DateTime.Now - 3
and
If olMail.ReceivedTime > days2ago Then

Answer 1

You can Restrict the number of items in the loop. https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
Sub test()
Dim outlookapp As Object
Dim olNs As Outlook.Namespace
Dim myFldr As Outlook.Folder
Dim objMail As Object
Dim myTasks As Outlook.Items
Dim daysAgo As Long
Dim projIDsearch As String
Dim myRecipient As Outlook.Recipient
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("SharedMailboxName")
myRecipient.Resolve
Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox)
projIDsearch = ActiveCell.Cells(1, 4)
' Restrict search to daysAgo
daysAgo = 3
Set myTasks = myFldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'")
For Each objMail In myTasks
If (InStr(1, objMail.Subject, projIDsearch, vbTextCompare) > 0) Then
objMail.Display
End If
Next
End Sub