Get outlook email items with excel VBA, restrict by date - excel

Question

I wrote the below code and it works perfect when I want to extract the outlook email items in my excel sheet, but it does not work when I want to get the emails that were received on a certain date:
Sub getMail()
Dim i As Long
Dim arrHeader As Variant
Dim olNS As Namespace
Dim olInboxFolder As MAPIFolder
Dim olItems As Items
Dim olItem As Variant
Set olNS = GetNamespace("MAPI")
Set olInboxFolder = olNS.PickFolder 'Pick folder
Set olItems = olInboxFolder.Items
arrHeader = Array("Date Created", "SenderEmailAddress", "Subject", "Body")
ThisWorkbook.Worksheets("Output").Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader
ActiveSheet.Range("E2", Range("E2").End(xlDown)).NumberFormat = "mm/dd/yyyy h:mm AM/PM"
i = 1
sFilter = InputBox("Enter Date")
FilterString = "[ReceivedTime] > sFilter "
For Each olItem In olItems.Restrict(FilterString)
' MailItem
If olItem.Class = olMail Then
Set mi = olItem
Debug.Print mi.ReceivedTime
ThisWorkbook.Worksheets("Output").Cells(i + 1, "A").Value = olItems(i).ReceivedTime
If olItems(i).SenderEmailType = "SMTP" Then
ThisWorkbook.Worksheets("Output").Cells(i + 1, "B").Value = olItems(i).SenderEmailAddress
ElseIf olItems(i).SenderEmailType = "EX" Then
ThisWorkbook.Worksheets("Output").Cells(i + 1, "B").Value = olItems(i).Sender.GetExchangeUser.PrimarySmtpAddress
End If
ThisWorkbook.Worksheets("Output").Cells(i + 1, "C").Value = olItems(i).Subject
ThisWorkbook.Worksheets("Output").Cells(i + 1, "D").Value = olItems(i).Body
i = i + 1
On Error Resume Next
' ReportItem
ElseIf olItem.Class = olReport Then
ThisWorkbook.Worksheets("Output").Cells(i + 1, "A").Value = olItems(i).CreationTime
ThisWorkbook.Worksheets("Output").Cells(i + 1, "B").Value = _
olItems(i).PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E04001E") 'PR_DISPLAY_TO
ThisWorkbook.Worksheets("Output").Cells(i + 1, "C").Value = olItems(i).Subject
i = i + 1
End If
Next olItem
ThisWorkbook.Worksheets("Output").Cells.EntireColumn.AutoFit
MsgBox "Export complete.", vbInformation
Set olItems = Nothing
Set olInboxFolder = Nothing
Set olNS = Nothing
End Sub
For example I want to get all the emails that were sent starting with 08/16/2020 date, Or get all the emails on a certain date range.

Answer 1

Private Sub getMail_InputBoxDate()
Dim olNS As namespace
Dim olFilterFolder As Folder
Dim olItems As Items
Dim olItem As Object
Dim mi As mailItem
Dim filterString As String
Dim sDate1 As String
Dim filterString1 As String
Dim sDate2 As String
Dim filterString2 As String
Dim olItemsRes As Items
Set olNS = GetNamespace("MAPI")
Set olFilterFolder = olNS.PickFolder 'Pick folder
Set olItems = olFilterFolder.Items
olItems.Sort "[ReceivedTime]", True
Debug.Print vbCr & "olItems.Count: " & olItems.Count
sDate1 = InputBox("Enter Start Date", , "2020-09-14")
'Debug.Print sDate1
sDate1 = Format(sDate1 & " 00:00 AM", "DDDDD HH:NN")
Debug.Print vbCr & "sDate1: " & sDate1
' Single quotes around variable.
filterString1 = "[ReceivedTime] >= '" & sDate1 & "'"
Debug.Print " filterString1: " & filterString1
Set olItemsRes = olItems.Restrict(filterString1)
Debug.Print " olItemsRes.Count: " & olItemsRes.Count
sDate2 = InputBox("Enter date, one day after desired range.", , "2020-09-15")
'Debug.Print sDate2
sDate2 = Format(sDate2 & " 00:00 AM", "DDDDD HH:NN")
Debug.Print vbCr & "sDate2: " & sDate2
' With single quotes around variable.
filterString2 = "[ReceivedTime] < '" & sDate2 & "'"
Debug.Print " filterString2: " & filterString2
' Option 1 - Restrict the previously restricted items
Set olItemsRes = olItemsRes.Restrict(filterString2)
Debug.Print " olItemsRes.Count: " & olItemsRes.Count
Debug.Print
For Each olItem In olItemsRes
' MailItem
If olItem.Class = olMail Then
Set mi = olItem
Debug.Print mi.ReceivedTime & " " & mi.Subject
End If
Next olItem
' Option 2 - Combine two working filters into one
filterString = filterString1 & " AND " & filterString2
Debug.Print vbCr & "filterString combined: " & filterString
' Restrict the original items once
Set olItemsRes = olItems.Restrict(filterString)
Debug.Print "olItemsRes.Count: " & olItemsRes.Count
Debug.Print
For Each olItem In olItemsRes
' MailItem
If olItem.Class = olMail Then
Set mi = olItem
Debug.Print mi.ReceivedTime & " " & mi.Subject
End If
Next olItem
Debug.Print vbCr & "Done."
End Sub
This is Restrict Outlook Items by Date but adds time to the user-input date.