[英]Search Outlook Emails from VBA
给定的代码成功运行。 它在 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
这可能不是您想要的方法,但是如果您添加对 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
),但这是一个概念性的想法来证明我的观点。
您可以使用限制检查已找到的项目中的地址。
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 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.