Get email from Outlook to Excel specified by received date - vba

Question

I am creating a macro to get email by subject and received date in our team shared box.
I use for loop to check all email in mailbox but it takes forever because my statement checks 1000+ mails.
How can I get email by specific date? Let's say I need email 12/1/2017 to 12/30/2017.
The key is using Restrict method but I don't know how I can use it.
Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Dim olShareName As Outlook.Recipient
Set olShareName = OutlookNamespace.CreateRecipient("sharemailbox#example.ca")
Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("sharebox subfolder").Folders("sharebox subfolder2")
i = 1
For Each OutlookMail In Folder.Items
If ((Range("From_Date").Value <= OutlookMail.ReceivedTime) And _
(OutlookMail.ReceivedTime <= Range("To_Date").Value)) And _
OutlookMail.Sender = "sender#example.com" Then
Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
i = i + 1
End If
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
I assume the code I have to fix is:
<For Each OutlookMail In Folder.Items>
How can I make statement using Restrict Method?

Answer 1

You could probably use the GetTable instead of a loop which has to process each email (or item) one by one.
GetTable will allow you to apply a filter on the content of the folder which should operate much faster.
For more details and an example, you can check the MSDN article on the Folder.GetTable Method for Outlook.
And for the specific filter that you are trying to apply, I would try:
"([ReceivedTime]>=12/1/17) AND ([ReceivedTime]<=12/30/17)"

Answer 2

You can create a collection of items restricted by date like this.
Option Explicit
Private Sub EmailInTimePeriod()
Dim oOlInb As Folder
Dim oOlItm As Object
Dim oOlResults As Object
Dim i As Long
Dim sFilterLower As String
Dim sFilterUpper As String
Dim sFilter As String
Dim dStart As Date
Dim dEnd As Date
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
' https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
' 12/1/2017 to 12/30/2017
'dStart = "2017/12/01"
'dEnd = "2017/12/30"
' 1/12/2018 to 1/15/2018
dStart = "2018/01/12"
dEnd = "2018/01/16"
' Lower Bound of the range
sFilterLower = "[ReceivedTime]>'" & Format(dStart, "DDDDD HH:NN") & "'"
Debug.Print vbCr & "sFilterLower: " & sFilterLower
' *** temporary demo lines
' Restrict the items in the folder
Set oOlResults = oOlInb.Items.Restrict(sFilterLower)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
' *** temporary demo lines
' Upper Bound of the range
sFilterUpper = "[ReceivedTime]<'" & Format(dEnd, "DDDDD HH:NN") & "'"
Debug.Print vbCr & "sFilterUpper: " & sFilterUpper
' *** temporary demo lines
' Restrict the Lower Bound result
Set oOlResults = oOlResults.Restrict(sFilterUpper)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
' *** temporary demo lines
' combine the filters
sFilter = sFilterLower & " AND " & sFilterUpper
Debug.Print vbCr & "sFilter: " & sFilter
Set oOlResults = oOlInb.Items.Restrict(sFilter)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
ExitRoutine:
Set oOlInb = Nothing
Set oOlResults = Nothing
Set oOlItm = Nothing
Debug.Print "Done."
End Sub
Note the code is set up to be used in Outlook.