從 VBA 搜索 Outlook 電子郵件

Question

給定的代碼成功運行。 它在 Outlook 已發送郵件文件夾中搜索電子郵件主題。 搜索基於特定時間段內的特定日期進行。 例如，下面的代碼查找在 2018 年 7 月 20 日上午 12:00 到晚上 11:59 之間發送的電子郵件標題“Test Email Sent on Friday”。

除了我現有的搜索條件之外，我如何過濾掉發送給特定用戶的電子郵件。 我想檢查 [To] 字段。 如果 [To] 的收件人為 x@email.com、y@email.com 或 z@email.com，則不返回搜索結果。 如果 [To] 部分沒有以下任一電子郵件：x@email.com、y@email.com 或 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

這可能不是您想要的方法，但是如果您添加對 Outlook 的項目引用，您可以使用本機數據類型，而不是將所有內容都視為對象，從那里 Intellisense 可以成為您最好的朋友。

優點是無需猜測Restrict方法中的查詢字符串是什么，您可以簡單地遍歷所有郵件項目，然后使用本機屬性查找您要查找的郵件項目。 這是您在上面確定的規格的示例。

 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

當然，你可以去掉類引用，它仍然可以工作，但就像我說的，讓 Intellisense 成為你的朋友。

有一些微優化是有序的（即預先聲明日期而不是在每次循環迭代中運行DateSerial ），但這是一個概念性的想法來證明我的觀點。

Answer 2

您可以使用限制檢查已找到的項目中的地址。

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

這是解決方案

    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