Select new Email by Subject and Date Range - vba

Question

I developed a macro to save attached files from selected emails with a subject depending on the body.
I would like to make the macro select the emails instead of doing it manually.
Goal: Select emails depending on their subject and an specific date range.
Filter mails received in a specified date range which corresponds with subject "Ordenes" and come from "ordenes#ordenes.com". This must be done without reading every single email on the inbox folder as I do not have the option of moving historical ones to another folder (shared email).
Select the mails that match the previous step and then call a macro called "SaveAttachements".
I've been checking Items.Restrict, Items.Find, Explorer.Selection, Explorer.AddToSelection but I don't seem to be getting the right concept.

Answer 1

You can filter (select) emails with .Restrict, which allows multiple conditions.
Option Explicit
Private Sub restrict_SenderEmailAddress_Subject_DateRangeRecent()
Dim itms As Items
Dim resItms As Items
Dim itm As Object
Dim srchSenderEmailAddress As String
Dim srchSubject As String
Dim dateRangeDays As Long
Dim srchDatePeriod As String
Dim strFilterBuild As String
Dim resItmsBuild As Items
Dim strFilter As String
Dim i As Long
Set itms = Session.GetDefaultFolder(olFolderInbox).Items
'For i = 1 To itms.Count
' Debug.Print itms(i).SenderEmailAddress
'Next
srchSenderEmailAddress = "ordenes#ordenes.com"
' If you cannot get the quotes right all at once, build the filter.
strFilterBuild = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email."
'MsgBox "No " & srchSenderEmailAddress & " email."
Exit Sub
End If
srchSubject = "Ordenes"
strFilterBuild = strFilterBuild & " And [Subject] = '" & srchSubject & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject
Exit Sub
End If
' adjust as needed
dateRangeDays = 1400
srchDatePeriod = Format(Date - dateRangeDays, "yyyy-mm-dd")
'Debug.Print srchDatePeriod
strFilterBuild = strFilterBuild & " And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
resItmsBuild.sort "[ReceivedTime]", True
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & dateRangeDays & " days."
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & datePeriodDays & " days."
Exit Sub
End If
' This should match the final strFilterBuild to confirm it can be done all at once.
strFilter = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "' And [Subject] = '" & srchSubject & "' And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilter
Set resItms = itms.Restrict(strFilter)
resItms.sort "[ReceivedTime]", True
If resItms.Count = 0 Then
MsgBox "No " & srchSubject & " email on " & srchDatePeriod
End If
For i = 1 To resItms.Count
Debug.Print resItms(i).ReceivedTime & ": " & resItms(i).Subject
'SaveAttachments resItms(i)
Next
End Sub