CODEWITHSUNDEEP
vbaoutlookoutlook-filter
Elliot Van
Elliot Van

Reputation: 11

Restrict Outlook Items to today's date - VBA

I've written some code that scans my default Outlook inbox for emails received today with a specific subject.

I then download the attachment for Outlook items that meet my criteria. I am having trouble designating the Restrict method to pull back items received today.

Here is what I have:

Sub DownloadAttachmentFirstUnreadEmail()

Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
Dim sFilter As String
Dim NewFileName As String

NewFileName = "C:\Temp\" & "CHG_Daily_Extract_" & Format(Date, "MM-DD-YYYY") & ".csv"

'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

'Declare email item restriction
sFilter = "[ReceivedTime] = '" & Format(Date, "DDDDD HH:NN") & "'"

'Catch
If oOlInb.Items.Restrict(sFilter).Count > 0 Then


'~~> Loop thru today's emails
For Each oOlItm In oOlInb.Items.Restrict(sFilter)

    '~> Check if the email subject matches
    If oOlItm = "ASG CDAS Daily CHG Report" Then

     '~~> Download the attachment
     For Each oOlAtch In oOlItm.Attachments
              oOlAtch.SaveAsFile NewFileName
            Exit For
        Next
        End If

    Exit For
Next

'Display if no emails today
Else: MsgBox "No items"

End If
End Sub

When I run the code, I consistently receive my catch message of "No items".

Please let me know if I am using the Restrict method incorrectly. Thank you so much for the help.

Upvotes: 1

Views: 3590

Answers (1)

0m3r
0m3r

Reputation: 12499

How about the following-

Filter = "@SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
                               Chr(34) & ")%

Or with Attachment

Filter = "@SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
                               Chr(34) & ")% AND " & _
                               Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                               Chr(34) & "=1"

Example

Option Explicit
Private Sub Examples()
    Dim olNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Msg As String
    Dim i As Long
    Dim Filter As String

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Filter = "@SQL=" & "%today(" & Chr(34) & ("urn:schemas:httpmail:datereceived") & _
                                   Chr(34) & ")%"


    Set Items = Inbox.Items.Restrict(Filter)

    Msg = Items.Count & " Items in " & Inbox.Name

    If MsgBox(Msg, vbYesNo) = vbYes Then
        For i = Items.Count To 1 Step -1
            Debug.Print Items(i) 'Immediate Window
        Next
    End If
End Sub

Filtering Items Using a Date-time Comparison MSDN

Outlook Date-time Macros

The date macros listed below return filter strings that compare the value of a given date-time property with a specified date in UTC; SchemaName is any valid date-time property referenced by namespace.

Note Outlook date-time macros can be used only in DASL queries.

Macro Syntax Description

  1. today %today(" SchemaName")% Restricts for items with SchemaName property value equal to today

More Examples Here

Upvotes: 1

Related Questions