按主题和日期范围选择新电子邮件答案

【问题标题】：Select new Email by Subject and Date Range按主题和日期范围选择新电子邮件
【发布时间】：2020-03-25 03:11:20
【问题描述】：

我开发了一个宏来保存所选电子邮件中的附件，其主题取决于正文。

我想让宏选择电子邮件而不是手动操作。

目标：根据主题和特定日期范围选择电子邮件。

过滤在指定日期范围内收到的与主题“Ordenes”相对应且来自“ordenes@ordenes.com”的邮件。这必须在不阅读收件箱文件夹中的每一封电子邮件的情况下完成，因为我无法将历史邮件移动到另一个文件夹（共享电子邮件）。
选择与上一步匹配的邮件，然后调用名为“SaveAttachements”的宏。

我一直在检查Items.Restrict、Items.Find、Explorer.Selection、Explorer.AddToSelection，但我似乎没有得到正确的概念。

【问题讨论】：

请您尝试查找和限制的查询。没有理由使用 Selection 对象。
“这必须在不阅读收件箱文件夹中的每一封电子邮件的情况下完成” - 据我所知这将是一个问题，宏可以遍历所有电子邮件并与符合您标准的电子邮件一起使用，但在通过它们之前它不能“过滤”。

标签： vba outlook

【解决方案1】：

您可以使用.Restrict 过滤（选择）电子邮件，它允许多个条件。

Option Explicit


Private Sub restrict_SenderEmailAddress_Subject_DateRangeRecent()

Dim itms As Items
Dim resItms As Items
Dim itm As Object

Dim srchSenderEmailAddress As String
Dim srchSubject As String

Dim dateRangeDays As Long
Dim srchDatePeriod As String

Dim strFilterBuild As String
Dim resItmsBuild As Items

Dim strFilter As String

Dim i As Long

Set itms = Session.GetDefaultFolder(olFolderInbox).Items

'For i = 1 To itms.Count
'    Debug.Print itms(i).SenderEmailAddress
'Next

srchSenderEmailAddress = "ordenes@ordenes.com"

' If you cannot get the quotes right all at once, build the filter.
strFilterBuild = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "'"
Debug.Print strFilterBuild

Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
    Debug.Print "No " & srchSenderEmailAddress & " email."
    'MsgBox "No " & srchSenderEmailAddress & " email."
    Exit Sub
End If

srchSubject = "Ordenes"

strFilterBuild = strFilterBuild & " And [Subject] = '" & srchSubject & "'"
Debug.Print strFilterBuild

Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
    Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject
    'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject
    Exit Sub
End If

' adjust as needed
dateRangeDays = 1400
srchDatePeriod = Format(Date - dateRangeDays, "yyyy-mm-dd")
'Debug.Print srchDatePeriod

strFilterBuild = strFilterBuild & " And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilterBuild

Set resItmsBuild = itms.Restrict(strFilterBuild)
resItmsBuild.sort "[ReceivedTime]", True

If resItmsBuild.Count = 0 Then
    Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & dateRangeDays & " days."
    'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & datePeriodDays & " days."
    Exit Sub
End If

' This should match the final strFilterBuild to confirm it can be done all at once.
strFilter = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "' And [Subject] = '" & srchSubject & "' And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilter

Set resItms = itms.Restrict(strFilter)
resItms.sort "[ReceivedTime]", True

If resItms.Count = 0 Then
    MsgBox "No " & srchSubject & " email on " & srchDatePeriod
End If

For i = 1 To resItms.Count
    Debug.Print resItms(i).ReceivedTime & ": " & resItms(i).Subject
    'SaveAttachments resItms(i)
Next

End Sub

【讨论】：