Outlook Technologies

Outlook Forms

Languages

Samples

More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 02-Sep-2010 22:33

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: intermediate Code area: Basic Outlook Printer Friendly Version
Title: All appointments for a date span
Description: To locate items that occur within a date span, look for all items that started before the end of the span and ended after the beginning of the span. It sounds weird, but try the DateSpan() function below in VBA or VB and see for yourself! Also note that when using a date to search with the Find or Restrict method, the date in the search string must be formatted as an unambiguous string, not a date literal, and must contain only years, months, days, hours, and minutes -- no seconds. A test routine is included so you can easily see how the DateSpan() function works.
Date: 12-Sep-2003 03:22
Code level: intermediate
Code area: Basic Outlook
Posted by: Sue Mosher
Body: Function DateSpan(colItems As Outlook.Items, _ dteStart As Date, dteEnd As Date) _ As Outlook.Items Dim colSpanItems As Outlook.Items On Error Resume Next colItems.Sort "[Start]" colItems.IncludeRecurrences = True strFind = "[Start] <= " & _ Quote(Format(dteEnd, "ddddd") & " 11:59 PM") & _ " AND [End] > " & _ Quote(Format(dteStart, "ddddd") & " 12:00 AM") 'MsgBox strFind Set colSpanItems = colItems.Restrict(strFind) If Err = 0 Then Set DateSpan = colSpanItems End If Set colSpanItems = Nothing End Function Function Quote(MyText) Quote = Chr(34) & MyText & Chr(34) End Function Sub TestDateSpan() Dim objOL As Outlook.Application Dim objNS As Outlook.NameSpace Dim colCal As Outlook.Items Dim objAppt As Outlook.AppointmentItem On Error Resume Next Set objOL = CreateObject("Outlook.Application") Set objNS = objOL.GetNamespace("MAPI") Set colCal = objNS.GetDefaultFolder(olFolderCalendar).Items Set colSpanItems = DateSpan(colCal, #9/1/2003#, #9/30/2003#) For Each objAppt In colSpanItems Debug.Print objAppt.Subject, objAppt.Start, objAppt.End Next Set objAppt = Nothing Set colSpanItems = Nothing Set colCal = Nothing End Sub
All 26comments

	Page [ 1 2 3 Next >> ]
	Adrian 18-Feb-2004 20:12 Hi Sue, I have created a custom form in Outlook 2000 and wish to prevent users from creating appointments that overlap. Using DateSpan appears to be the answer I have been lookign for but when I try to run the TestDateSpan function within my form I get the error: Expected ')'. It seems to be failing at the first line in the DateSpan function, and does the same when I run it as a macro from within Word 2000. What am I doing wrong? Cheers in Advance, Adrian
	Adrian 19-Feb-2004 23:21 Sue, I have managed to get this working using both the 'Find' & 'Restrict' methods. I have created a function that returns either 0 or 1 depending on wether it finds another appointment in the range or not. When I use the 'find' method my procedure returns the correct result until the user tries to make an appointment that spans multiple appointments. When I use the 'restrict' method my function returns a 1 every time. How do I loop through the items that are returned in the search? the code I have used is below, cheers: Function check_time() ' Checks that the start and end times of this new appointment are not occupied by another appointment or travel time. dim objApp dim olns dim MyFolder dim MyTasks dim MyTask dim reqStime dim reqEtime set olns = Item.Application.GetNameSpace("MAPI") set rootfol = olns.Folders("Public Folders") set fol2 = rootfol.Folders("All Public Folders") set fol3 = fol2.Folders("agencies") set fol4 = fol3.Folders("company name") set fol5 = fol4.Folders("Car Booking") set MyFolder = fol5.Folders("test folder") set MyTasks = MyFolder.Items MyTasks.Sort "[Start]" MyTasks.IncludeRecurrences = True reqStime = BuildDate(Item.GetInspector.ModifiedFormPages("Car Booking").txtstart.value) reqEtime = BuildDate(Item.GetInspector.ModifiedFormPages("Car Booking").txtend.value) strFind = "[Start] " & Quote(reqEtime) 'Set MyTask = MyTasks.Find(strFind) Set MyTask = MyTasks.Restrict(strFind) if not MyTask Is Nothing then check_time = "1" else check_time = "0" end if End Function
	Sue Mosher 20-Feb-2004 14:34 Restrict always returns an Items collection, not an individual item. You can check the Count property of the collection to determine whether it's non-zero: Set myItems = MyTasks.Restrict(strFind) MsgBox myItems.Count It would be a bit more elegant to use True and False as results for your function, rather than the strings "1" and "0": Check_Time = (Not MyTask Is Nothing) Check_Time = (MyItems.Count > 0) Finally, in a public folder, Find is preferable. The search done by Restrict is cached on the folder, which can lead to performance problems in some situations.
	Adrian 22-Feb-2004 21:06 Thanks for your help sue, much appreciated :-) I am using the find method at the moment, but I find in my testing that this is a little unreliable. It only seems to find an item when the range is within a single appointment. As soon as the range spans several appointments it does not return a result. Also if only the start or end time is within an existing appointment the search does not return a result either. Any ideas as to why this would be?
	Sue Mosher 23-Feb-2004 10:21 I don't know what you mean by "the range is within a single appointment" or "the range spans several appointments." How are you building the search string that Find uses?
	Sue Mosher 23-Feb-2004 10:23 Also, see http://www.slipstick.com/dev/finddate.htm for more information on constructing Find and Restrict strings for dates.
	Adrian 23-Feb-2004 19:26 I am trying to prevent concurrent appointments. I get the function to search for existing appointments using a range built from the new appointment (item.start and item.end). If the user selects a date range that already has an existing appointment (i.e appointment exists from 9-11am and user selects appointment from 9-11am or any range within the existing appointment time) it works fine. However if the user tries to create an appointment from 10am-12 it will not return a result, even though the start time is within the range of the existing appointment. The search string looks something like this: strFind = "[Start] = " & Quote(MyEndTime) I'm pretty sure the this 'should' work, but I have no idea why it doesn't in this situation?
	Sue Mosher 25-Feb-2004 18:31 That simple a search string won't do the job. Please see the article I suggested. It has detailed information on how to search across a range and get all appointments even partially inside it. The trick is to search for appointments that start before the end of your date/time range and all those that end after the start of your range.
	Matt 11-Oct-2006 12:46 Sue, Thanks for posting the code for this, is there a way to change this to export a shared calendar? Thanks in advance, Matt
	Sue Mosher 18-Oct-2006 11:40 Matt, if by "a shared calendar," you mean the Calendar folder in another user's mailbox, you'd use the Namespace.GetSharedDefaultFolder method instead of GetDefaultFolder to return the other user's folder.
	Page [ 1 2 3 Next >> ]

name email