• 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

    Hui...

  • 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

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:
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.
 
Back
Top