I'm trying to use Excel VBA to filter out my outlook mail inbox and then eventually send email if condition meets.
The full condition is: If the Outlook Inbox contains Subject within the date range(past 7 days) and from Sender(dynamic sender email).
I had completed the sub sendEmails()
, now struggling with filtering mails.
The code I have now successfully filter out the subject I'm looking at. However, after trying to include in the date range into the filter, It screwd up.
First Problem: The filter is giving me
Run-Time Error 13: Type Mismatch.
I knew this happens because the filter contains String
and Date
values, so I tried to change type to variant
but still ran into the error.
Another issue is that I followed this post for attempting to add the date conditions. And this post to apply filter for date. Properly many errors so appreciated if somebody with experience can correct my mistakes. (Haven't run to there yet, but just having strong feeling will hit errors)
This is my first time working with this so please go easy on me.
Sub Search_Inbox()
Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim Filter As Variant
Dim tdyDate As String
Dim checkDate As Date
tdyDate = Format(Now(), "Short Date")
checkDate = DateAdd("d", -7, tdyDate) ' DateAdd(interval,number,date)
Set objNamespace = myOlApp.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
'https://msdn.microsoft.com/en-us/library/aa579702(v=exchg.80).aspx
Filter = "@SQL=" & Chr(34) & "(urn:schemas:httpmail:subject" & Chr(34) & " like 'Reminder on Subject' &" _
And Chr(34) & "urn:schemas:httpmail:datereceived >= & checkDate & " _
And Chr(34) & "urn:schemas:httpmail:datereceived >= & tdyDate &"
Set filteredItems = objFolder.Items.Restrict(Filter)
If filteredItems.Count = 0 Then
Debug.Print "No emails found"
Found = False
Else
Found = True
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
Debug.Print itm.Subject
Next
End If
'If the subject isn't found:
If Not Found Then
'NoResults.Show
Else
Debug.Print "Found " & filteredItems.Count & " items."
End If
Set myOlApp = Nothing
End Sub