Restrict method filter with multiple date conditio

2019-07-13 05:07发布

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

1条回答
孤傲高冷的网名
2楼-- · 2019-07-13 05:48

Assuming you're only having problem in adding date filers you can find something useful here.
Now applying it to your code, you will have to enclose your dates with single quotes (').

Although dates and times are typically stored with a Date format, the Find and Restrict methods require that the date and time be converted to a string representation.

Dim tdyDate As String, checkDate As String

tdyDate = "'" & Format(Date, "Short Date") & "'"
checkDate = "'" & Format(Date - 7, "Short Date") & "'"

Alternatively you can try:

tdyDate = Format(Date, "\'ddddd\'") '/* until todays date */
checkDate = Format(Date - 7, "\'ddddd\'") '/* I suppose you are filtering 7 days ago? */

And then constructing your filter:

eFilter = "@SQL= (urn:schemas:httpmail:subject Like 'Reminder on Subject'" & _
          " And urn:schemas:httpmail:datereceived >= " & checkDate & _
          " And urn:schemas:httpmail:datereceived <= " & tdyDate & ")"

Note: I used eFilter instead of Filter as variable because it is a reserved word in VBA.

which will give you:

@SQL= (urn:schemas:httpmail:subject Like 'Reminder on Subject' And urn:schemas:httpmail:datereceived >= '1/2/2018' And urn:schemas:httpmail:datereceived <= '1/9/2018')

查看更多
登录 后发表回答