Question

我应该每天都会收到来自"Testing Protocol"的主题"BobSmith@company.com"的电子邮件。

有没有办法搜索我的Outlook收件箱，以确定电子邮件是否已通过该主题和当天的发件人？我喜欢简单的＆＃34;是＆＃34;或＆＃34;否＆＃34;被放置在＆＃34; Control＆＃34;的单元格A1中如果今天已收到或尚未收到。

以下是我试图用以前的问题自己想出来的，没有运气。

非常感谢任何帮助。 EmailSubject = "Testing Protocol"

Private Sub Application_Reminder(ByVal Item As Object)

Dim EmailSubject As Range
Set EmailSubject = Sheets("Control").Range("EmailSubject")

If Item.Class = olTask Then
    If InStr(Item.Subject, EmailSubject) > 0 Then
        ReminderUnreceivedMail
    End If
End If

End Sub

Sub ReminderUnreceivedMail()

Dim Itms As Items
Dim srchSender As String
Dim srchSubject As String

Set Itms = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
srchSender = "BobSmith@company.com"
srchSubject = EmailSubject

Set Itms = Itms.Restrict("[SenderName] = "BobSmith@company.com" And 
[Subject] = EmailSubject And [SentOn] > '" & Format(Date, "yyyy-mm-dd") & 
"'")

If Itms.Count = 0 Then
    MsgBox "No " & srchSubject & " email on " & Format(Date, "yyyy-mm-dd")
End If

Set Itms = Nothing

End Sub

Answer 1

对于我来说，srchSender的格式可能错误并且组合过滤器需要一系列令人困惑的匹配引号。

Private Sub ReminderUnreceivedMail()

Dim Itms As items
Dim srchSender As String
Dim srchSubject As String

Dim strFilterBuild As String
Dim ItmsBuild As items

Dim strFilter As String
Set Itms = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).items

Dim i As Long
For i = 1 To Itms.count
    Debug.Print Itms(i).senderName
Next

srchSender = "what you see in senderName from the above"
srchSubject = "EmailSubject"

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

Set ItmsBuild = Itms.Restrict(strFilterBuild)
If ItmsBuild.count = 0 Then
    MsgBox "No " & srchSender & " email."
    GoTo ExitRoutine
End If

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

Set ItmsBuild = Itms.Restrict(strFilterBuild)
If ItmsBuild.count = 0 Then
    ' This should find old mail
    MsgBox "No " & srchSender & " email with subject " & srchSubject
    GoTo ExitRoutine
End If

strFilterBuild = strFilterBuild & " And [SentOn] > '" & Format(Date, "yyyy-mm-dd") & "'"
Debug.Print strFilterBuild

Set ItmsBuild = Itms.Restrict(strFilterBuild)
If ItmsBuild.count = 0 Then
    MsgBox "No " & srchSender & " email with subject " & srchSubject & " today"
    GoTo ExitRoutine
End If

' This should match the final strFilterBuild to confirm it can be done all at once.
strFilter = "[SenderName] = '" & srchSender & "' And [Subject] = '" & srchSubject & "' And [SentOn] > '" & Format(Date, "yyyy-mm-dd") & "'"
Debug.Print strFilter

Set Itms = Itms.Restrict(strFilter)
If Itms.count = 0 Then
    MsgBox "No " & srchSubject & " email on " & Format(Date, "yyyy-mm-dd")
End If

ExitRoutine:
    Set Itms = Nothing

End Sub

根据发件人，主题和今天的日期搜索Outlook电子邮件

1 个答案: