Warning: file_get_contents(/data/phpspider/zhask/data//catemap/2/node.js/41.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 从VBA搜索Outlook电子邮件_Excel_Vba_Ms Access_Outlook - Fatal编程技术网

Excel 从VBA搜索Outlook电子邮件

Excel 从VBA搜索Outlook电子邮件,excel,vba,ms-access,outlook,Excel,Vba,Ms Access,Outlook,给定的代码工作成功。它在outlook“已发送邮件”文件夹中搜索电子邮件主题。搜索基于特定时间段内的特定日期进行。例如,下面的代码查找2018年7月20日12:00 AM至11:59 PM之间发送的电子邮件标题“Test email Sent on Friday” 除了我现有的搜索条件外,我如何过滤发送给特定用户的电子邮件。我要检查[到]字段。如果[收件人]有收件人x@email.com, y@email.com或z@email.com,则不返回搜索结果。如果[收件人]部分没有以下任一电子邮件,

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

除了我现有的搜索条件外,我如何过滤发送给特定用户的电子邮件。我要检查[到]字段。如果[收件人]有收件人x@email.com, y@email.com或z@email.com,则不返回搜索结果。如果[收件人]部分没有以下任一电子邮件,则搜索应返回“Yes.Email found”: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
Public函数是\u email\u sent()
作为对象的Dim-olApp
作为对象的模糊olNs
作为对象的Dim olFldr
作为对象的Dim olItms
作为对象的Dim objItem
出错时继续下一步
设置olApp=CreateObject(“Outlook.Application”)
Set olNs=olApp.GetNamespace(“MAPI”)
设置olFldr=olNs.Folders(“myemail@example.com“”。文件夹(“已发送邮件”)
设置olItms=olFldr.项目

设置objItem=olItms.Restrict(“[Subject]=”周五发送的测试电子邮件“,[SentOn]>=”2018年7月20日12:00 AM“,[SentOn]这可能不是您所寻求的方法,但如果您向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
Public函数是\u email\u sent()
Dim olApp作为Outlook.Application
将OLN设置为Outlook.Namespace
将olFldr设置为Outlook.Folder
将olItms设置为Outlook.Items
将对象对象设置为Outlook.MailItem
Dim recipients()作为字符串
Dim被发现为布尔值
发现=错误
出错时继续下一步
Set olApp=newoutlook.Application
Set olNs=olApp.GetNamespace(“MAPI”)
设置olFldr=olNs.Folders(“myemail@example.com“”。文件夹(“已发送邮件”)
对于olFldr.项中的每个对象项
如果objItem.Subject=“测试周五发送的电子邮件”和_
objItem.SentOn>=日期序列(2018,7,20)和_
objItem.SentOn
当然,你可以去掉类引用,它仍然有效,但是就像我说的,让Intellisense成为你的朋友


有一些微优化是有序的(即预先声明日期,而不是在每个循环迭代中运行
DateSerial
),但这是一个概念性的想法来证明我的观点。

您可以使用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
Public函数是\u email\u sent()
作为对象的Dim-olApp
作为对象的模糊olNs
作为对象的Dim olFldr
将olFldrItms设置为对象的Outlook.Items
将对象项作为对象的Outlook.Items进行调整
作为对象的Dim objResItem
“出错时继续下一步”了解如何使用此选项。
设置olApp=CreateObject(“Outlook.Application”)
Set olNs=olApp.GetNamespace(“MAPI”)
设置olNs=GetNamespace(“MAPI”)
设置olFldr=olNs.Folders(“myemail@example.com“”。文件夹(“已发送邮件”)
设置olFldrItms=olFldr.Items
设置objResItems=olFldrItms.Restrict(“[Subject]=”周五发送的测试电子邮件“,[SentOn]>=”2018年7月20日12:00 AM“,[SentOn]以下是解决方案

    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
Public函数是\u email\u sent()
作为对象的Dim-olApp
作为对象的模糊olNs
作为对象的Dim olFldr
作为对象的Dim olItms
作为对象的Dim objItem
出错时继续下一步
设置olApp=CreateObject(“Outlook.Application”)
Set olNs=olApp.GetNamespace(“MAPI”)
设置olFldr=olNs.Folders(“myemail@example.com“”。文件夹(“已发送邮件”)
设置olItms=olFldr.项目

设置objItem=olItms.Restrict(“[Subject]=”星期五发送的测试电子邮件“,[SentOn]>=”2018年7月20日12:00 AM“,[SentOn]可能的重复项。还有一些其他的和其他的。你已经知道如何筛选,因为它在你的代码中。将附加条件添加到筛选器以排除电子邮件地址。@Ken White添加[to]或[到]=''.'.'.'.'.'.'.'.'.'.'在我的过滤器中没有任何作用。太好了。谢谢你。我会测试你的解决方案并让你不断更新。我唯一关心的代码是我可能需要循环1000封电子邮件才能找到我要找的标题。因为我将搜索最新的电子邮件,我会按SentOn降序排序电子邮件,然后循环through items。代码运行成功,但由于发送了大量项目,速度太慢。我会找到方法对其进行优化。我敢打赌,如果您仍然使用Restrict方法将结果获取到一个子集,那么for each循环将运行得非常快。如果您需要一个示例,请告诉我。
错误恢复下一步
在这里没有任何好处。未来这样使用只会让你感到沮丧。你不会看到任何错误,这意味着你无法修复它们。如果你想在
is\u email\u sent
中返回一个值,那么
is\u email\u sent\u out\u to\u business=False
应该是
is\u email\u sent=False
。你可能还需要一个
is\u email\u sent=True
嗯。