Using the Restrictions method for emails within a specified date

Question

I create a macro to receive email on the topic and get the date in our team. My problem is that as soon as I select a date (e, g 1/16/2018 - 1/17/2018), only a few letters are stored in the object. In the screenshot below, I have 9 elements that are applied by the restriction method. This should be 14 e-mails that were received after 1/16/2018 to the present (right Outlook email in the screenshot), but 5 emails are not stored in the object. Can someone help me? I KNOCK!

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Dim olItems As Outlook.Items
Dim myItems As Outlook.Items
Dim DateStr As Date
Dim DateEnd As Date
Dim oOlResults As Object

Dim DateToCheck As String
Dim DateToCheck2 As String
Dim DateToCheck3 As String

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Dim olShareName As Outlook.Recipient
Set olShareName = OutlookNamespace.CreateRecipient("[e-mail]")
Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("sub1").Folders("sub2")
Set olItems = Folder.Items


'DateStr = 1/16/2018
'DateEnd = 1/17/2018

DateStr = Format(Range("From_Date").Value, "DDDDD HH:NN")
DateEnd = Format(Range("To_Date").Value, "DDDDD HH:NN")

'DateStr = DateAdd("d", -1, DateStr)
'DateEnd = DateAdd("d", 1, DateEnd)

DateToCheck = "[ReceivedTime] > """ & DateStr & """"
DateToCheck2 = "[ReceivedTime] <= """ & DateEnd & """"
DateToCheck3 = "[SenderName] = ""[e-mail]"""

Set myItems = olItems.Restrict(DateToCheck)
Set myItems = myItems.Restrict(DateToCheck2)
Set myItems = myItems.Restrict(DateToCheck3)

i = 1

For Each myitem In myItems
    ' MsgBox myitem.ReceivedTime

     Range("eMail_subject").Offset(i, 0).Value = myitem.Subject
     Range("eMail_date").Offset(i, 0).Value = myitem.ReceivedTime

     i = i + 1

Next myitem

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing


End Sub

Answer 1

Retrieving my comment, you can try using below with the following considerations:

• , datereceived UTC. UTC. UTC8, 8 _{( . , , UTC.
  > ).}

• , .

  , Find Restrict , .

  :

  mydate = Format(Now,"\'m/d/yyy hh:mm AM/PM\'") '/* will give '1/23/2018 01:36 PM' */
  

• sendername .

---

Sub stancial()
    Dim olItems As Outlook.Items
    Dim olFolder As Outlook.Folder
    Dim olNS As Outlook.NameSpace
    Dim olEmail As Outlook.MailItem
    Dim i As Long

    Dim efilter As String, startdt As String, endindt As String, _
        myUTC As Integer, sentby As String

    myUTC = 8 '/* this is your UTC, change to suit (in my case 8) */

    startdt = Format(DateAdd("h", -myUTC, _
              CDate("1/18/2018 12:00 PM")), "\'m/d/yyyy hh:mm AM/PM\'")
    endindt = Format(DateAdd("h", -myUTC, _
              CDate("1/18/2018 4:00 PM")), "\'m/d/yyyy hh:mm AM/PM\'")
    sentby = "'[e-mail]'" '/* can be sendername, "doe, john" */

    Set olNS = Application.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
    '/* filter in one go, where datereceived is
    'expressed in UTC (Universal Coordinated Time) */
    efilter = "@SQL= (urn:schemas:httpmail:sendername = " & sentby & _
              " And (urn:schemas:httpmail:datereceived >= " & startdt & _
              " And urn:schemas:httpmail:datereceived <= " & endindt & "))"

    Set olItems = olFolder.Items.Restrict(efilter)

    With olItems
        For i = .Count To 1 Step -1 '/* starting from most recent */
            If TypeOf .Item(i) Is MailItem Then
                Set olEmail = .Item(i)
                Debug.Print olEmail.Subject, olEmail.ReceivedTime
            End If
        Next
    End With
End Sub

Answer 2

, DateEnd . 00:00.

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant

Dim i As Integer

Dim olItems As Outlook.Items
Dim myItems As Outlook.Items
Dim myitem As Object

Dim DateStr As String
Dim DateEnd As String

Dim oOlResults As Object

Dim DateToCheck As String
Dim DateToCheck2 As String
Dim DateToCheck3 As String

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Dim olShareName As Outlook.Recipient
'Set olShareName = OutlookNamespace.CreateRecipient("[e-mail]")
'Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olfolderinbox).Folders("sub1").Folders("sub2")

' for my testing
Set Folder = OutlookNamespace.getdefaultfolder(olfolderinbox)

Set olItems = Folder.Items

DateStr = "2018-01-16"
Debug.Print DateStr

' User input DateEnd without a time
DateEnd = "2018-01-17"
Debug.Print DateEnd

' Calculated DateEnd is the beginning of the next day
DateEnd = DateAdd("d", 1, DateEnd)
' This is 2018-01-18 00:00
Debug.Print DateEnd

DateToCheck = "[ReceivedTime] > """ & DateStr & """"
Debug.Print vbCr & "Filter 1: " & DateToCheck

Set myItems = olItems.Restrict(DateToCheck)

For Each myitem In myItems
    Debug.Print myitem.ReceivedTime & ": " & myitem.Subject
Next myitem

'DateToCheck2 = "[ReceivedTime] <= """ & DateEnd & """"
DateToCheck2 = "[ReceivedTime] < """ & DateEnd & """"
Debug.Print vbCr & "Filter 2: " & DateToCheck2

Set myItems = myItems.Restrict(DateToCheck2)

For Each myitem In myItems
    Debug.Print myitem.ReceivedTime & ": " & myitem.Subject
Next myitem

DateToCheck3 = "[SenderName] = ""[e-mail]"""
Debug.Print vbCr & "Filter 3: " & DateToCheck3

Set myItems = myItems.Restrict(DateToCheck3)

For Each myitem In myItems
    Debug.Print myitem.ReceivedTime & ": " & myitem.Subject
Next myitem

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Answer 3

Your code uses the DateToCheck3 restriction - the other two are ignored by your code. If you want to combine several constraints, combine them into a single query using the AND operator.