Search Outlook Emails from VBA

Question

The given code works successfully. It searches for an email subject in outlook Sent Items folder. The search happens based on a specific date within specific time period. For example, the code below looks for the email title "Test Email Sent on Friday" that was sent on July 20, 2018 between 12:00 AM and 11:59 PM.

In addition to my existing search criteria, how can I filter out emails that were sent out to specific users. I want to check [To] field. If [To] had recipients x@email.com, y@email.com, or z@email.com, then do not return the search results. The search should return "Yes. Email found" if [To] section doesn't have either of these emails: x@email.com, y@email.com, or z@email.com.

 Public Function is_email_sent()
    Dim olApp As Object
    Dim olNs As Object
    Dim olFldr As Object
    Dim olItms As Object
    Dim objItem As Object

    On Error Resume Next
    Set olApp = CreateObject("Outlook.Application")

    Set olNs = olApp.GetNamespace("MAPI")
    Set olFldr = olNs.Folders("myemail@example.com").Folders("Sent Items")

    Set olItms = olFldr.Items
    Set objItem = olItms.Restrict("[Subject] = ""Test Email Sent on Friday"" And [SentOn] >= ""7/20/2018 12:00 AM"" AND [SentOn] <= ""7/20/2018 11:59 PM""")
    If objItem.Count = 0 Then
        MsgBox "No. Email not found"
    Else
        MsgBox "Yes. Email found"
    End If

    Set olApp = Nothing
    Set olNs = Nothing
    Set olFldr = Nothing
    Set olItms = Nothing
    Set objItem = Nothing
End Function

Answer 1

This may not be the approach you were seeking, but if you add a project reference to Outlook, you can use the native datatypes instead of treating everything as an object, and from there Intellisense can be your best friend.

The advantage is that instead of guessing what the query string is in the Restrict method, you can simply loop through all mail items and then use the native properties to find the one(s) you are looking for. Here is an example with the specifications you identified above.

 Public Function is_email_sent()
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFldr As Outlook.Folder
    Dim olItms As Outlook.Items
    Dim objItem As Outlook.MailItem
    Dim recipients() As String
    Dim found As Boolean

    found = False

    On Error Resume Next
    Set olApp = New Outlook.Application

    Set olNs = olApp.GetNamespace("MAPI")
    Set olFldr = olNs.Folders("myemail@example.com").Folders("Sent Items")

    For Each objItem In olFldr.Items
      If objItem.Subject = "Test Email Sent on Friday" And _
        objItem.SentOn >= DateSerial(2018, 7, 20) And _
        objItem.SentOn < DateSerial(2018, 7, 21) Then

          If InStr(objItem.To, "x@email.com") = 0 And _
            InStr(objItem.To, "y@email.com") = 0 And _
            InStr(objItem.To, "z@email.com") = 0 Then

              found = True
              Exit For

          End If

      End If
    Next objItem

And of course, you can strip out the class references and it will still work, but like I said, let Intellisense be your friend.

There are some micro-optimizations that are in order (ie pre-declaring the dates rather than running DateSerial within each loop iteration), but this is a notional idea to demonstrate my point.

Answer 2

You can check the addresses in the items already found with Restrict.

Public Function is_email_sent()

    Dim olApp As Object
    Dim olNs As Object

    Dim olFldr As Object
    Dim olFldrItms As Object    ' Outlook.Items

    Dim objResItems As Object   ' Outlook.Items
    Dim objResItem As Object

    'On Error Resume Next       ' Learn how to use this.

    Set olApp = CreateObject("Outlook.Application")

    Set olNs = olApp.GetNamespace("MAPI")
    Set olNs = GetNamespace("MAPI")

    Set olFldr = olNs.Folders("myemail@example.com").Folders("Sent Items")

    Set olFldrItms = olFldr.Items

    Set objResItems = olFldrItms.Restrict("[Subject] = ""Test Email Sent on Friday"" And [SentOn] >= ""7/20/2018 12:00 AM"" AND [SentOn] <= ""7/20/2018 11:59 PM""")

    If objResItems.count = 0 Then

        MsgBox "Email not found."

    Else

        For Each objResItem In objResItems

            Debug.Print objResItem.Subject
            Debug.Print objResItem.To

            If InStr(objResItem.To, "x@email.com") = 0 And _
              InStr(objResItem.To, "y@email.com") = 0 And _
              InStr(objResItem.To, "z@email.com") = 0 Then

                MsgBox "Email to " & objResItem.To & vbCr & vbCr & "No bad addresses."
                Exit For

            End If

            Debug.Print "At least one bad address in the mail."

        Next

    End If

    Set olApp = Nothing
    Set olNs = Nothing
    Set olFldr = Nothing

    Set olFldrItms = Nothing
    Set objResItems = Nothing

    Set objResItem = Nothing

End Function

Answer 3

Here is the solution

    Public Function is_email_sent()
        Dim olApp As Object
        Dim olNs As Object
        Dim olFldr As Object
        Dim olItms As Object
        Dim objItem As Object

        On Error Resume Next
        Set olApp = CreateObject("Outlook.Application")

        Set olNs = olApp.GetNamespace("MAPI")
        Set olFldr = olNs.Folders("myemail@example.com").Folders("Sent Items")

        Set olItms = olFldr.Items
        Set objItem = olItms.Restrict("[Subject] = ""Test Email Sent on Friday"" And [SentOn] >= ""7/20/2018 12:00 AM"" AND [SentOn] <= ""7/20/2018 11:59 PM""")
        If objItem.Count = 0 Then
            is_email_sent_out_to_business = False
        Else '*** Solution
            Dim o As Object
            For Each o In objItem
                If Not (InStr(o.To, "x@email.com") > 0 Or InStr(o.To, "y@email.com") > 0) Then
                    MsgBox "Yes. Email found"
                    Exit For
                Else
                    MsgBox "No. Email not found"
                End If
            Next
        End If

        Set olApp = Nothing
        Set olNs = Nothing
        Set olFldr = Nothing
        Set olItms = Nothing
        Set objItem = Nothing
    End Function