从VBA搜索Outlook电子邮件

时间:2018-07-20 21:23:21

标签: vba excel-vba access-vba outlook-vba

给定的代码成功运行。它在Outlook“已发送邮件”文件夹中搜索电子邮件主题。搜索基于特定时间段内的特定日期进行。例如,下面的代码查找2018年7月20日12:00 AM至11:59 PM之间发送的电子邮件标题``星期五发送的电子邮件''。

除了现有的搜索条件外,如何过滤发送给特定用户的电子邮件。我要检查[收件人]字段。如果[收件人]有收件人x @ email.com,y @ email.com或z@email.com,则不要返回搜索结果。如果[收件人]部分没有以下电子邮件中的任何一个,则搜索应返回“是。已找到电子邮件”。xp @ 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

3 个答案:

答案 0 :(得分:1)

这可能不是您要寻找的方法,但是如果您添加对Outlook的项目引用,则可以使用本机数据类型,而不是将所有内容都视为对象,因此Intellisense可能是您最好的朋友。

enter image description here

优点在于,您不必猜测var privateKey = require('fs').readFileSync('./xxxxxxx.pem', {'encoding':'utf8'}); 方法中的查询字符串是什么,只需循环浏览所有邮件项目,然后使用本机属性来查找所需的内容。这是您上面确定的规格的示例。

Restrict

当然,您可以删除类引用,它仍然可以工作,但是就像我说的那样,让Intellisense成为您的朋友。

有一些按顺序进行的微优化(即在每次循环迭代中预先声明日期而不是运行 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 ),但这是一个概念性的论证。

答案 1 :(得分:0)

您可以在“限制”中找到的项目中检查地址。

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

答案 2 :(得分:0)

这是解决方案

    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