Get email from Outlook to Excel specified by received date

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?

Roll back this edit and create a new question so you do not invalidate the answers already received. — niton, Jan 17 '18 at 19:31
https://stackoverflow.com/questions/48308994/using-restrict-method-for-emails-in-specified-date-vba-but-some-emails-are-not — Jason, Jan 17 '18 at 19:55
@Jason I have done the rollback for you. (I was about to VTC your new question because it was identical to this one, but then noticed the comments saying you had edited this question into something different.) — YowE3K, Jan 17 '18 at 20:28

DecimalTurn · Answer 1 · 2018-01-16T15:50:28.633

2

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)"

edited Jan 16 '18 at 15:50

answered Jan 16 '18 at 03:31

DecimalTurn

3,243
3
16
36

I used GetTable as you suggested, but how to define Filter? my statement is Filter = "[LastModificationTime] > '1/12/2018'" , but I want specified by received date. e.g) I need emails 1/12/2018 to 1/15/2018. Can anyone help me out? – Jason Jan 16 '18 at 14:54
I edited my answer to address this part of your question. – DecimalTurn Jan 16 '18 at 15:51
Related: https://stackoverflow.com/questions/35084636/how-to-filter-mails-using-received-time-using-vba – DecimalTurn Jan 16 '18 at 16:02

score 1 · Accepted Answer · answered Jan 16 '18 at 22:06

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.

Thanks for your help. It works for me, but problem is now if I want to get emails received date 2018/1/12 to 2018/1/16 only 10 items out of 15 selected and store object. out of 5 emails are same received date but it's not stored can anyone help? — Jason, Jan 17 '18 at 18:54
Create another question for the problem with your current code. — niton, Jan 17 '18 at 19:16

Get email from Outlook to Excel specified by received date

2 Answers2

Linked