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

Question

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

我想让宏选择电子邮件，而不是手动进行。

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

1. 过滤在指定日期范围内收到的与主题“ Ordenes”相对应且来自“ [email protected]”的邮件。必须这样做，而不必阅读收件箱文件夹中的每一封电子邮件，因为我没有选择将历史邮件移到另一个文件夹（共享电子邮件）。
2. 选择与上一步匹配的邮件，然后调用一个名为“ SaveAttachements”的宏。

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

Answer 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 = "[email protected]"

' 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