Search for sent items with today's date and specific subject - vba

Question

I want when Outlook opens to:
Search sent items with today's date with a specific subject.
If none is found, then send the "Test" email.
If found, display messagebox that says "Email is found".
I have only been able to do #1.
Private Sub Application_Startup()
Dim MItem As MailItem
Set MItem = Application.CreateItem(olMailItem)
MItem.Subject = "Test Alert"
MItem.To = "email#abc.com"
MItem.DeferredDeliveryTime = DateAdd("n", 1, Now) 'n = minute, h=hour
MItem.Send
End Sub
Update:
This is what I've tried. It doesn't seem to be searching the Sent Items folder with the subject.
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
On Error Resume Next
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(Outlook.olFolderSentMail)
For Each objItem In olFldr.Items
If objItem.Subject = "Test Alert" And _
objItem.SentOn = Date Then _
MsgBox "Yes. Email found"
Else
MsgBox "No. Email not found"
Exit For
End If
Next objItem
End Function

Answer 1

The main error is misuse of On Error Resume Next. Errors are bypassed, not fixed.
Public Sub is_email_sentFIX()
Dim olFldr As Folder
Dim olItms As Items
Dim objItem As Object
Dim bFound As Boolean
' Not useful here.
' Use for specific purpose to bypass **expected** errors.
'On Error Resume Next
Set olFldr = Session.GetDefaultFolder(olFolderSentMail)
Set olItms = olFldr.Items
olItms.sort "[SentOn]", True
For Each objItem In olItms
If objItem.Class = OlMail Then
Debug.Print objItem.Subject
If objItem.Subject = "Test Alert" Then
Debug.Print objItem.SentOn
Debug.Print Date
If objItem.SentOn > Date Then
MsgBox "Yes. Email found"
bFound = True
Exit For
End If
End If
End If
Next objItem
If bFound = False Then
MsgBox "No. Email not found"
End If
End Sub
If there are an excessive number of items in the Sent folder the "not found" outcome will be slow.
One possible option to the brute force way is to Restrict to the specific item, rather than using If statements.

Answer 2

this is some code ive used;
Sub sendmail10101() 'this is to send the email from contents in a cell
Dim obApp As Object
Dim NewMail As MailItem
Set obApp = Outlook.Application
Set NewMail = obApp.CreateItem(olMailItem)
'You can change the concrete info as per your needs
With NewMail
.Subject = Cells(21, 3).Value
.To = Cells(18, 3).Value
.Body = "Good day" & vbCrLf & "i hope you are keeping well " & vbCrLf & vbCrLf & "please can you assist with the below members infomation;" & vbCrLf & vbCrLf & vbCrLf & Cells(20, 3).Value
'.Attachments.Add ("C:\Attachments\Test File.docx")
.Importance = olImportanceHigh
.Display
End With
Set obApp = Nothing
Set NewMail = Nothing
End Sub
the next part is to search the mail box, which you can also use to search from the first initial cell;
Option Explicit
Public Sub Search_Outlook_Emails()
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outStartFolder As Outlook.MAPIFolder
Dim foundEmail As Outlook.MailItem
Set outApp = New Outlook.Application
Set outNs = outApp.GetNamespace("MAPI")
'Start at Inbox's parent folder
Set outStartFolder = outNs.GetDefaultFolder(Outlook.olFolderInbox).Parent
'Or start at folder selected by user
'Set outStartFolder = outNs.PickFolder
If Not outStartFolder Is Nothing Then
Set foundEmail = Find_Email_In_Folder(outStartFolder, ThisWorkbook.Sheets("Dashboard").TextBox1.Value)
If Not foundEmail Is Nothing Then
If MsgBox("Email subject: " & foundEmail.Subject & vbNewLine & vbNewLine & _
"Folder: " & foundEmail.Parent.FolderPath & vbNewLine & vbNewLine & _
"Open the email?", vbYesNo, "'" & ThisWorkbook.Sheets("Dashboard").TextBox1.Value & "' found") = vbYes Then
foundEmail.Display
End If
Else
MsgBox "", vbOKOnly, "'" & ThisWorkbook.Sheets("Dashboard").TextBox1.Value & "' not found"
End If
End If
End Sub
Private Function Find_Email_In_Folder(outFolder As Outlook.MAPIFolder, findText As String) As Outlook.MailItem
Dim outItem As Object
Dim outMail As Outlook.MailItem
Dim outSubFolder As Outlook.MAPIFolder
Dim i As Long
Debug.Print outFolder.FolderPath
Set Find_Email_In_Folder = Nothing
'Search emails in this folder
i = 1
While i <= outFolder.Items.Count And Find_Email_In_Folder Is Nothing
Set outItem = outFolder.Items(i)
If outItem.Class = Outlook.OlObjectClass.olMail Then
'Does the findText occur in this email's body text?
Set outMail = outItem
If InStr(1, outMail.Body, findText, vbTextCompare) > 0 Then Set Find_Email_In_Folder = outMail
End If
i = i + 1
Wend
DoEvents
'If not found, search emails in subfolders
i = 1
While i <= outFolder.Folders.Count And Find_Email_In_Folder Is Nothing
Set outSubFolder = outFolder.Folders(i)
'Only check mail item folders
If outSubFolder.DefaultItemType = Outlook.olMailItem Then Set Find_Email_In_Folder = Find_Email_In_Folder(outSubFolder, findText)
i = i + 1
Wend
End Function
the previous code brings us a message box to say if its been found which can be removed but maybe use the message box and an IF statement
such as;
with activeworkbook
if msgbox.value = "yes" then
range("A1:A30") = "COMPLETED" 'ASSUMING THIS IS THE INTIAL TEST RANGE IT WILL CHANGE THE SUBJECT THUS STOPPING THE FIRST MACRO
end if
end with
or if no message box then use something such as IF found then so on...
hope this helps