Finding appointments within a specific time frame
When programmatically searching for Appointments within a given time frame, it may seem logical to search for items that Start at the Start of your time frame and End at the End of your time frame. For example using a restriction similar to this with the Outlook Object Model:
[Start] >= MyStartDate AND [End] <= MyEndDate
But, what does this actually do? It will only find items that Start AND End within your time frame. This may sound correct at first and may be exactly what you want, but usually this is not what people want to do since it will not find any appointments that overlap your Start and/or End times
Here is a simple diagram to help explain why this is important. The query above will find the appointment in this scenario (where S = Start & E = End of my time frame on the timeline “------“ )
------------------S------------------------------E--------------------------
|---Appt---|
But it will not find these appointments that overlap the Start or End of the time frame:
------------------S------------------------------E--------------------------
|-------------Appt_1----------|
|--------Appt_2-----------|
|----------------------------Appt_3---------------------------|
To reliably find all appointments that occur within a time frame you need to use a query that looks for appointments that Start before the End of your time frame:
------------------S------------------------------E--------------------------
ß----------------------------------------|
And End after the start of your time frame.
------------------S------------------------------E--------------------------
|---------------------------------------------à
Using this logic will return all of the Appointments that occur within the specified time frame.
Here is the updated restriction:
[Start] <= MyEndDate AND [End] >= MyStartDate
This is what it looks like with real dates:
[Start] <= '3/19/2007 12:00 AM' AND [End] >= '3/14/2007 12:00 AM'
Here are some samples:
Outlook Object Model (OOM) VBA sample:
==================================
Sub FindApptsInTimeFrame()
myStart = Format(Date, "mm/dd/yyyy hh:mm AMPM")
myEnd = DateAdd("d", 5, myStart)
myEnd = Format(myEnd, "mm/dd/yyyy hh:mm AMPM")
Debug.Print "Start:", myStart
Debug.Print "End:", myEnd
Set oSession = Application.Session
Set oCalendar = oSession.GetDefaultFolder(olFolderCalendar)
Set oItems = oCalendar.Items
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"
strRestriction = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Debug.Print strRestriction
Set oResitems = oItems.Restrict(strRestriction)
oResitems.Sort "[Start]"
For Each oAppt In oResitems
Debug.Print oAppt.Start, oAppt.Subject
Next
End Sub
CDO 1.21 sample:
==================================
Sub CDOGetApptsInTimeFrame()
'Requires a Reference to Microsoft CDO version 1.21.
Dim oSession As MAPI.Session
Dim oCalendar As MAPI.FOLDER
Dim oAppt As MAPI.AppointmentItem
Dim oRecurPat As MAPI.RecurrencePattern
Set oSession = New MAPI.Session
oSession.Logon
Set oCalendar = oSession.GetDefaultFolder(CdoDefaultFolderCalendar)
Set oMsgColl = oCalendar.Messages
Set oMsgFilter = oMsgColl.Filter
oMsgFilter.Fields.Add CdoPR_START_DATE, "3/19/07"
oMsgFilter.Fields.Add CdoPR_END_DATE, "3/14/07"
Set oAppt = oMsgColl.GetFirst
Do While (Not oAppt Is Nothing)
Debug.Print oAppt.StartTime, oAppt.Subject
Set oAppt = oMsgColl.GetNext
Loop
End Sub
WebDAV Sample:
==================================
Sub GetApptsInTimeFrame()
Const SERVERNAME = "ExchangeServer"
Const MAILBOXNAME = "TestUser"
Const UserName = "" '"TestDomain\TestUser"
Const Password = "" '"TestPassword"
Const FOLDER = "Calendar/"
sURL = "https://" & SERVERNAME & "/exchange/" & MAILBOXNAME & "/" & FOLDER
sStartTime = "2007-03-14T00:00:00.000Z"
sEndTime = "2007-03-19T00:00:00.000Z"
Debug.Print sURL
Dim strPropReq As String
strPropReq = "<?xml version='1.0'?>" & _
"<d:searchrequest" & _
" xmlns:d=""DAV:""" & _
" xmlns:cal=""urn:schemas:calendar:"" >"
strPropReq = strPropReq & "<d:sql> SELECT ""DAV:href"", " & _
" ""urn:schemas:calendar:dtstart"", " & _
" ""urn:schemas:calendar:dtend"" " & _
" FROM Scope('SHALLOW TRAVERSAL OF """ & sURL & """ ')" & _
"WHERE ""DAV:contentclass"" = 'urn:content-classes:appointment'" & _
"AND ""urn:schemas:calendar:dtstart"" <= " & _
"CAST(""" & sEndTime & """ AS ""dateTime.tz"")" & _
"AND ""urn:schemas:calendar:dtend"" >= " & _
"CAST(""" & sStartTime & """ AS ""dateTime.tz"")"
strPropReq = strPropReq & "</></>"
Dim oXMLHttp As XMLHTTPRequest
Set oXMLHttp = CreateObject("Microsoft.XMLHTTP")
With oXMLHttp
.Open "SEARCH", sURL, False, UserName, Password
.setRequestHeader "Content-type:", "text/xml"
.setRequestHeader "Depth", "1,noroot"
.Send (strPropReq)
Debug.Print .Status
strOutPutFile = Environ("USERPROFILE") & "\Desktop\XMLOutput.xml"
Open strOutPutFile For Output As #1
Print #1, .responseText
Close #1
End With
End Sub
VB.NET Sample:
==================================
Imports Outlook = Microsoft.Office.Interop.Outlook
Imports System.Runtime.InteropServices
Public Class Form1
' NOTE: Requires a COM reference to the Microsoft Outloook 12.0 Object Library
Private Sub cmdGetApptsInTimeFrame_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdGetAppointments.Click
Dim OL As Outlook.Application
OL = New Outlook.Application()
Dim myStart As String = Format(#6/1/2008#, "MM/dd/yyyy hh:mm tt")
Dim myEnd As String = Format(#7/1/2008#, "MM/dd/yyyy hh:mm tt")
Debug.Print("Looking for appointments between " & myStart & " and " & myEnd)
Dim oSession As Outlook.NameSpace = OL.Session()
Dim oCalendar As Outlook.MAPIFolder = oSession.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
Dim oItems As Outlook.Items = oCalendar.Items()
oItems.IncludeRecurrences = True
oItems.Sort("[Start]")
Dim strRestriction As String = "[Start] <= '" & myEnd _
& "' AND [End] >= '" & myStart & "'"
Debug.Print(strRestriction)
Dim oResitems As Outlook.Items = oItems.Restrict(strRestriction)
oResitems.Sort("[Start]")
Dim oAppt As Outlook.AppointmentItem
oAppt = Nothing
For Each oAppt In oResitems
Debug.Print(oAppt.Start().ToString & " - " & oAppt.Subject().ToString)
Next
' Clean up
If Not oAppt Is Nothing Then Marshal.ReleaseComObject(oAppt)
oAppt = Nothing
If Not oResitems Is Nothing Then Marshal.ReleaseComObject(oResitems)
oResitems = Nothing
If Not oItems Is Nothing Then Marshal.ReleaseComObject(oItems)
oItems = Nothing
If Not oCalendar Is Nothing Then Marshal.ReleaseComObject(oCalendar)
oCalendar = Nothing
If Not oSession Is Nothing Then Marshal.ReleaseComObject(oSession)
oSession = Nothing
If Not OL Is Nothing Then Marshal.ReleaseComObject(OL)
OL = Nothing
End Sub
End Class