• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Get outlook email items with excel VBA, restrict by date


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:
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




    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.