Search for Outlook Email based on Sender, Subject,

问题:

I am supposed to receive an email with the subject "Testing Protocol" from "[e-mail]" every day.

Is there a way to search my Outlook Inbox to determine if an email has come through with that subject and that sender for the current day? Id like a simple "Yes" or "No" to be placed in cell A1 of "Control" if it has or has not been received today.

Below is what I have tried to come up with on my own using previous questions with no luck.

Any help is greatly appreciated. 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 = "[e-mail]"
srchSubject = EmailSubject

Set Itms = Itms.Restrict("[SenderName] = "[e-mail]" 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

回答1:

Likely wrong format for srchSender and combining a filter, for me, requires a confusing sequence of matching quotes.

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