Using Restrict method for emails within a specified date

前端 未结 3 1333
说谎
说谎 2021-01-23 08:40

I am creating a macro to get email by subject and received date in our team shared box. My problem is that once I select date (e,g 1/16/2018 to 1/17/2018), only few emails are s

相关标签:
3条回答
  • 2021-01-23 08:57

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

    0 讨论(0)
  • 2021-01-23 09:10

    If you are missing most recent mail then set DateEnd, without time, one day later. This should calculate to the beginning of the day at time 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("Mailbox.sharedmailbox@example.ca")
    '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] = ""no-reply@example.com"""
    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
    
    0 讨论(0)
  • 2021-01-23 09:12

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

    1. Received date, datereceived is expressed in UTC. So you need to adjust your time depending on your UTC. In my case it is UTC8 so I need to adjust the time 8 hours earlier (Note: No documentation to support this, but when I did my testing, it is expressed in UTC.
      It may or may not always be the case
      ).
    2. Date should be expressed as string as stated here.

      Although dates and times are typically stored with a Date format, the Find and Restrict methods require that the date and time be converted to a string representation.

      Example:

      mydate = Format(Now,"\'m/d/yyy hh:mm AM/PM\'") '/* will give '1/23/2018 01:36 PM' */
      
    3. sendername may contain the email address or the email name.

    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 = "'john.doe@email.com'" '/* 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
    
    0 讨论(0)
提交回复
热议问题