tardox
New Member
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:
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.
C++:
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.