I have an Outlook macro that filters email objects by date and returns items based on an array.
The filter for today is the following:
sfilter = "[ReceivedTime]>=""&Date()12:00am&"""
Set myItems = myNewFolder.Items.Restrict(sfilter)
sFilter is a string and this returns the items for today as intended.
I am trying to filter to emails received yesterday.
The following were my attempts.
sfilter = "[ReceivedTime]>=""&Date(-1) 12:00am&"" AND [ReceivedTime]<= ""&Date() 12:00am&"" "
tfilter = Format(DateAdd("d", -1, Date), "mm/dd/yyyy")
rFilter = Format(DateAdd("d", 0, Date), "mm/dd/yyyy")
I intended to use the tFilter and rFilter as the upper and lower bound for sFilter.
I tried to use the DateAdd method after looking on the MSDN site with the function information but that did not return yesterday's items.
I tried the solution offered on this question (Outlook .Restrict method does not work with Date).
The method with date(-1) did not work in tandem with date. According to the MSDN site logical operators should work.
Note: The lower three examples cited compile and do not return any errors.
You can find yesterday's mail with two separate Restricts.
Private Sub EmailYesterday()
Dim oOlInb As Folder
Dim oOlItm As Object
Dim oOlResults As Object
Dim i As Long
Dim sFilter As String
Dim sFilter2 As String
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
'Filter recent - Lower Bound of the range
sFilter = "[ReceivedTime]>'" & format(Date - 1, "DDDDD HH:NN") & "'"
Debug.Print vbCr & sFilter
Set oOlResults = oOlInb.Items.Restrict(sFilter)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.Subject & " - " & oOlItm.ReceivedTime
Next i
End If
' Filter range - Upper Bound
sFilter2 = "[ReceivedTime]<'" & format(Date, "DDDDD HH:NN") & "'"
Debug.Print vbCr & sFilter; " AND " & sFilter2
Set oOlResults = oOlResults.Restrict(sFilter2) ' Restrict the Lower Bound result
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.Subject & " - " & oOlItm.ReceivedTime
Next i
End If
ExitRoutine:
Set oOlInb = Nothing
Set oOlResults = Nothing
Debug.Print "Done."
End Sub
Yesterday date could be filtered as below
oOlResults.Restrict("#SQL=%yesterday(""urn:schemas:httpmail:datereceived"")%")
The same for today or this month.
oOlResults.Restrict("#SQL=%today(""urn:schemas:httpmail:datereceived"")%")
oOlResults.Restrict("#SQL=%thismonth(""urn:schemas:httpmail:datereceived"")%")
More info here
Related
I am extracting all appointments across all Outlook accounts for today.
I am experiencing the same issue encountered in this post here, but I am trying to do this through VBA.
Originally I managed to get the appointments for today, but it would also return reoccurring meetings that are not taking place today (like in the linked question).
I do not understand how the Powershell code, in the answer, manages to filter out the reoccurring appointments, because in my VBA attempt I get the whole week of appointments.
This is my attempt. I've included the filter where I get the appointments for today as well the reoccurring appointments which do not take place today.
Sub GetAllCalendarAppointmentsForToday()
Dim olApplication As Outlook.Application
Dim olNamespace As NameSpace
Dim olAccounts As Accounts
Dim olStore As Outlook.Store
Dim olCalendarFolder As Outlook.Folder
Dim olCalendarItems As Outlook.Items
Dim olTodayCalendarItems As Outlook.Items
Dim strFilter As String
Dim strFilter2 As String
Set olApplication = CreateObject("Outlook.Application")
Set olNamespace = olApplication.Session
Set olAccounts = olNamespace.Accounts
Debug.Print olAccounts.Count
For Each oAccount In olAccounts
Debug.Print oAccount
Set olStore = oAccount.DeliveryStore
Set olCalendarFolder = olStore.GetDefaultFolder(olFolderCalendar)
Set olCalendarItems = olCalendarFolder.Items
olCalendarItems.Sort "[Start]", True
olCalendarItems.IncludeRecurrences = True
Debug.Print olCalendarItems.Count
'Find your today's appointments
strFilter = Format(Now, "ddddd")
strFilter2 = Format(DateAdd("d", 7, Now), "ddddd")
Debug.Print strFilter
Debug.Print strFilter2
'strFilter = "[Start] > " & Chr(34) & strFilter & " 00:00" & Chr(34) & " AND [Start] < " & Chr(34) & strFilter & " 00:00" & Chr(34)
strFilter = "[Start] > " & Chr(34) & strFilter & " 00:00" & Chr(34) & " AND [Start] < " & Chr(34) & strFilter2 & " 00:00" & Chr(34)
Debug.Print strFilter
Set olTodayCalendarItems = olCalendarItems.Restrict(strFilter)
Debug.Print olTodayCalendarItems.Count
Debug.Print "Begin Print of Appointments"
For Each objAppointment In olTodayCalendarItems
Counter = Counter + 1
Debug.Print Counter & ":" & objAppointment.Subject & " " & objAppointment.Location & " [" & objAppointment.Start & "|" & objAppointment.End & "]"
Next
Debug.Print vbNewLine
Next
End Sub
Edit #1:
As per Eugene's answer, I updated the strFilter to be this to no avail
strFilter = [Start] <= '07/15/2020 11:59 PM' AND [End] >= '07/15/2020 12:00 AM'
In addition, I put IncludeReccurence first as well and no change in the results
Edit #2
Replaced the for each loop to use GetFirst() and GetNext() to no avail
Set olTodayCalendarItems = olCalendarItems.Restrict(strFilter)
Set olItem = olTodayCalendarItems.GetFirst()
Do While Not olItem Is Nothing
Set olAppointment = olItem
counter = counter + 1
Debug.Print counter & ":" & olAppointment.Subject & " " & olAppointment.Location & " [" & olAppointment.Start & "|" & olAppointment.End & "]"
Set olItem = olTodayCalendarItems.GetNext()
Loop
Edit #3:
I created a VB.NET application where I used the function, provided in the link in the answer, verbatim and it worked as expected. So maybe there is a issue in VBA (unlikely) or I missed something small in my VBA script?
Edit #4:
The problem was in my logic all along. Items needed to be sorted in ascending. Thank you to both Eugene and niton
The OP left a comment to indicate Restrict is valid.
" ... the link to the docs on IncludeRecurrences ... mentioned that .Sort needs to be done in ascending order"
It is possible .Restrict is not appropriate for this task.
An example using .Find.
Items.IncludeRecurrences property(Outlook) https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences
Sub DemoFindNext()
' https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
Debug.Print currentAppointment.Subject
' MsgBox currentAppointment.Subject
Set currentAppointment = myAppointments.FindNext
Wend
End Sub
Microsoft doesn’t recommend using the Count property in case you set the IncludeRecurrences property. The Count property may return unexpected results and cause an infinite loop. Read more about that in the How To: Use Restrict method in Outlook to get calendar items article.
Here is a sample VB.NET code where you can see how you can filter appointment items properly:
Imports System.Text
Imports System.Diagnostics
' ...
Private Sub RestrictCalendarItems(folder As Outlook.MAPIFolder)
Dim dtEnd As DateTime = New DateTime(DateTime.Now.Year, DateTime.Now.Month, _
DateTime.Now.Day, 23, 59, 0, 0)
Dim restrictCriteria As String = "[Start]<=""" + dtEnd.ToString("g") + """" + _
" AND [End]>=""" + DateTime.Now.ToString("g") + """"
Dim strBuilder As StringBuilder = Nothing
Dim folderItems As Outlook.Items = Nothing
Dim resultItems As Outlook.Items = Nothing
Dim appItem As Outlook._AppointmentItem = Nothing
Dim counter As Integer = 0
Dim item As Object = Nothing
Try
strBuilder = New StringBuilder()
folderItems = folder.Items
folderItems.IncludeRecurrences = True
folderItems.Sort("[Start]")
resultItems = folderItems.Restrict(restrictCriteria)
item = resultItems.GetFirst()
Do
If Not IsNothing(item) Then
If (TypeOf (item) Is Outlook._AppointmentItem) Then
counter = counter + 1
appItem = item
strBuilder.AppendLine("#" + counter.ToString() + _
" Start: " + appItem.Start.ToString() + _
" Subject: " + appItem.Subject + _
" Location: " + appItem.Location)
End If
Marshal.ReleaseComObject(item)
item = resultItems.GetNext()
End If
Loop Until IsNothing(item)
If (strBuilder.Length > 0) Then
Debug.WriteLine(strBuilder.ToString())
Else
Debug.WriteLine("There is no match in the " _
+ folder.Name + " folder.")
End If
catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
Finally
If Not IsNothing(folderItems) Then Marshal.ReleaseComObject(folderItems)
If Not IsNothing(resultItems) Then Marshal.ReleaseComObject(resultItems)
End Try
End Sub
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.
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
today %today(" SchemaName")% Restricts for items with SchemaName
property value equal to today
More Examples Here
I am creating a macro to get email by subject and received date in our team shared box.
I use for loop to check all email in mailbox but it takes forever because my statement checks 1000+ mails.
How can I get email by specific date? Let's say I need email 12/1/2017 to 12/30/2017.
The key is using Restrict method but I don't know how I can use it.
Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Dim olShareName As Outlook.Recipient
Set olShareName = OutlookNamespace.CreateRecipient("sharemailbox#example.ca")
Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("sharebox subfolder").Folders("sharebox subfolder2")
i = 1
For Each OutlookMail In Folder.Items
If ((Range("From_Date").Value <= OutlookMail.ReceivedTime) And _
(OutlookMail.ReceivedTime <= Range("To_Date").Value)) And _
OutlookMail.Sender = "sender#example.com" Then
Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
i = i + 1
End If
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
I assume the code I have to fix is:
<For Each OutlookMail In Folder.Items>
How can I make statement using Restrict Method?
You could probably use the GetTable instead of a loop which has to process each email (or item) one by one.
GetTable will allow you to apply a filter on the content of the folder which should operate much faster.
For more details and an example, you can check the MSDN article on the Folder.GetTable Method for Outlook.
And for the specific filter that you are trying to apply, I would try:
"([ReceivedTime]>=12/1/17) AND ([ReceivedTime]<=12/30/17)"
You can create a collection of items restricted by date like this.
Option Explicit
Private Sub EmailInTimePeriod()
Dim oOlInb As Folder
Dim oOlItm As Object
Dim oOlResults As Object
Dim i As Long
Dim sFilterLower As String
Dim sFilterUpper As String
Dim sFilter As String
Dim dStart As Date
Dim dEnd As Date
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
' https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
' 12/1/2017 to 12/30/2017
'dStart = "2017/12/01"
'dEnd = "2017/12/30"
' 1/12/2018 to 1/15/2018
dStart = "2018/01/12"
dEnd = "2018/01/16"
' Lower Bound of the range
sFilterLower = "[ReceivedTime]>'" & Format(dStart, "DDDDD HH:NN") & "'"
Debug.Print vbCr & "sFilterLower: " & sFilterLower
' *** temporary demo lines
' Restrict the items in the folder
Set oOlResults = oOlInb.Items.Restrict(sFilterLower)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
' *** temporary demo lines
' Upper Bound of the range
sFilterUpper = "[ReceivedTime]<'" & Format(dEnd, "DDDDD HH:NN") & "'"
Debug.Print vbCr & "sFilterUpper: " & sFilterUpper
' *** temporary demo lines
' Restrict the Lower Bound result
Set oOlResults = oOlResults.Restrict(sFilterUpper)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
' *** temporary demo lines
' combine the filters
sFilter = sFilterLower & " AND " & sFilterUpper
Debug.Print vbCr & "sFilter: " & sFilter
Set oOlResults = oOlInb.Items.Restrict(sFilter)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
ExitRoutine:
Set oOlInb = Nothing
Set oOlResults = Nothing
Set oOlItm = Nothing
Debug.Print "Done."
End Sub
Note the code is set up to be used in Outlook.
I'm trying to grab the last week of appointments using VBA in Outlook.
I'm using the .Restrict method, but something is making my string grab 3 years further back.
I start by declaring formatted dates for my time bracket:
myStart = Format(DateAdd("d", -7, Now()), "ddddd h:nn AMPM")
myEnd = Format(Now(), "ddddd h:nn AMPM")
I build a string to hold my restriction criterion.
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Finally I call restrict on my appointment items:
Set oRestrItems = oItems.Restrict(strRestriction)
For a little more context, here's how I use/call the result:
For Each oApptItem In oRestrItems 'oItems will grab everything, but that's hardly perfect.
If oApptItem.Sensitivity <> olPrivate Then
MsgBox (oApptItem.Subject)
MsgBox (oApptItem.Start)
MsgBox (oApptItem.End)
End If
Next
I can guess that you are missing two statements.
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
If this is the case, you can ask another question about why the Restrict requires these additional statements. Someone may have an answer.
Minimal, Complete, and Verifiable example. Try commenting out either or both statements. You should see that the items are not the same.
Option Explicit
Sub LastWeekAppts()
Dim objFolder As Folder
Dim oItems As items
Dim oRestrItems As items
Dim strRestriction As String
Dim myStart As Date
Dim myEnd As Date
Dim temp As Object
Set objFolder = Session.GetDefaultFolder(olFolderCalendar)
Set oItems = objFolder.items
' *****************************************
' Odd results without these two statements
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
' *****************************************
myEnd = Date
myStart = DateAdd("d", -7, Date)
Debug.Print " myStart: " & myStart
Debug.Print " myEnd : " & myEnd
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Debug.Print strRestriction
Set oRestrItems = oItems.Restrict(strRestriction)
For Each temp In oRestrItems
Debug.Print temp.start & " - " & temp.Subject
Next temp
End Sub
I'm trying from Excel to scan a shared inbox for emails with attachments, which were received on a certain date. The aim is to save the attachments and import them into the workbook running the code.
Here's the code I have so far adapted from Download attachment from Outlook and Open in Excel to scan the inbox and print some info on the emails it finds
Sub extractEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object, oOlInp As Object
Dim oOlItm As Object
Dim strDateFrom As String, strDateTo As String
Dim searchDate As Date
searchDate = #12/9/2015# 'mm/dd/yyyy
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInp = oOlns.Folders("SHR-Cust Ops MI Team Inbox")
Set oOlInb = oOlInp.Folders("Inbox")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[attachment] = True AND [receivedTime] > " & strDateFrom & " AND [receivedTime] < " & strDateTo)
Debug.Print oOlItm.ReceivedTime & " " & oOlItm.Subject
Next
End Sub
When I search for the 8th of December it only brings back emails that were received after 8am.
I changed the settings for working hours in the calendar to midnight to midnight (no working hours) and the code then brought back all emails for the specified date. However, I can't leave my calendar with no working hours. Is there a way to change the default behaviour to ignore the working hours?
It sure sounds like your are getting GMT + your local time zone offset.
What is your TZ?
After messing around with this a little I've found a solution. A very obvious one. You can't just provide the date, you also need to provide a time, so:
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
Becomes
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy hh:mm") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy hh:mm") & "'"