The alternative ‘AutoPick’ free slot finder for Outlook Calendar

You might recognize the situation where you have to schedule meetings in Microsoft Outlook and it's impossible to find a free slot where all required participants are fully available.

Solution

To deal with this situation I wrote an Outlook Macro / Add-In that automatically finds the best slot within a pre-defined period. ‘The best slot’ is defined as the slot where most participants are at least tentatively available.

Why the ‘AutoPick’ functionality is not sufficient

Microsoft Outlook already has the feature to automatically select a slot for all required participants:

AutoPick

This is great functionality to find a slot where all participants are fully ‘free’ / ‘available’. In reality, though, people are hardly ever fully available, esp. higher up in the organization, unless you schedule a meeting 4 months in advance. For this reason, I created an alternative version that searches for a slot where required participants should at least be available ‘tentatively’. So a slot like this will be suggested:

Free slot

Installation

In Outlook, open the code editor by pressing Alt+F11, paste the code from here, go to the scheduling assistant and right-click your ribbon, and select ‘Customize the Ribbon’

Customize the Ribbon

select macros:

Select Macro

and add the Macro to a custom ‘Macro folder’ in your ribbon:

Add to custom group

You can rename your macro and display an icon as desired with the ‘rename’ option in this menu:

Rename and select icon

The slot finder will appear next to the regular one:

New slot finder in menu

The code

Outlook exposes the calendar information of participants with the FreeBusy method. This method returns the availability of the provided participant in the next 4 weeks as a character string. Each character represents a slot of a provided amount of minutes.

Logical structure

The below code will iterate through the slots and check if all participants are fully available or partially available within a chosen time frame (users are prompted to provide the number of weeks to evaluate). If no slot is found, a new search (loop iteration) will search again with adjusted success criteria, the loop with exit (and select the slot) when the number of participants minus 1 are able to at least tentatively join the meeting. The next iteration will exit with the number of participants minus 2, etc.

High-level loop structure — with line number reference

Scroll down to view the code with line numbers.

Line 42 starts a loop that counts the number of attendees that need to be removed from the success criteria. Line 47, checks if there is sufficient availability among the participants (within the time frame). During the first round of evaluations, all participants need to be Free or Tentatively available, in the next round all participants minus 1 participant need to be available.

Line 43 starts the loop to evaluate all slots (that have been retrieved in lines 22–33).

Line 45 loops through all participants, to check if the participant is available (line 47).

If all required participants are available (line 51), then a check is done if the slot is a workday and workhour (line 54), if so, the user is notified that a suitable slot has been found (line 58).

	Sub check_availability()
	Dim myOlApp As New Outlook.Application
	Set myNameSpace = myOlApp.GetNamespace("MAPI")
	Set objApp = CreateObject("Outlook.Application")
	'Set objItem = Outlook.Application.ActiveExplorer.Selection.Item(1)
	Set objItem = objApp.ActiveInspector.CurrentItem
	'Set objAttendees = Outlook.Application.ActiveExplorer.Selection.Item(1).Recipients
	Set objAttendees = objItem.Recipients
	Dim oCurrentUser As Recipient
	Dim FreeBusy(20, 2) As String
	Dim BusySlot As Long
	Dim DateBusySlot As Date
	Dim i As Long
	Const SlotLength = 30
	Dim teller As Integer
	Dim eruit As Boolean
	eruit = False
	Dim aantalre As Integer
	Dim StartDate As Date
	StartDate = Format(objItem.Start, "dd-mm-yyyy") 'DateAdd("n", SlotLength, objItem.Start)
	'Debug.Print StartDate
	Dim delta As Variant
	delta0 = (DateDiff("n", DataValue(Format(objItem.Start, "dd-mm-yyyy")), objItem.Start) / SlotLength)
	st = CDate(CLng(objItem.Start))
	delta = ((DateDiff("n", st, objItem.Start)) / SlotLength)
	aantalre = 0
	For X = 1 To objAttendees.Count
	If (objAttendees(X).Type = 1 And objAttendees(X).Sendable = True) Or objAttendees(X).Index = 1 Then
	Set myRecipient = myNameSpace.CreateRecipient(objAttendees(X).Address)
	On Error Resume Next
	FreeBusy(X, 1) = myRecipient.FreeBusy(StartDate, SlotLength, True)
	'debug.print objAttendees(X).Name & " " & vbCrLf & Left(FreeBusy(X, 1), 200)
	If Err.Number < 0 Then
	MsgBox "Unable to get Calendar for " & objAttendees(X).Name
	End If
	FreeBusy(X, 2) = objAttendees(X).Name
	aantalre = aantalre + 1
	End If
	Next
	'debug.print Len(FreeBusy(1, 1))
	Dim Message, Title, Default, aantal
	Message = "Enter number of weeks (max 4)" ' Set prompt.
	Title = "Input for max number of weeks" ' Set title.
	Default = "1" ' Set default.
	' Display message, title, and default value.
	aantal = InputBox(Message, Title, Default)
	For re = 0 To objAttendees.Count
	For i = delta + 2 To (aantal * 7 * 24 / (SlotLength / 60)) + delta + 2 'delta is the adjustment for the hours, since FreeBusy works with whole days
	teller = 0
	For Y = 1 To 20
	If Len(FreeBusy(Y, 1)) > 1 Then
	If CLng(Mid(FreeBusy(Y, 1), i, 1)) = 0 Or CLng(Mid(FreeBusy(Y, 1), i, 1)) = 1 Then
	teller = teller + 1
	End If
	If teller = aantalre - re Then
	BusySlot = (i - 1) * SlotLength
	DateBusySlot = DateAdd("n", BusySlot, StartDate)
	If TimeValue(DateBusySlot) >= TimeValue(#9:00:00 AM#) And TimeValue(DateBusySlot) <= TimeValue(#5:00:00 PM#) And Not (Weekday(DateBusySlot) = vbSaturday Or Weekday(DateBusySlot) = vbSunday) Then
	Debug.Print " first open interval:" & Y & "I: " & FreeBusy(Y, 2) & "i: " & i & _
	vbCrLf & _
	Format$(DateBusySlot, "mm\/dd\/yyyy hh:mm AM/PM")
	MsgBox "Found slot for " & aantalre - re & "/" & aantalre & " participants"
	'objItem.Start = Format$(DateBusySlot, "mm\/dd\/yyyy hh:mm AM/PM") 20221229, changed below as well
	objItem.Start = Format$(DateBusySlot, "dd\/mm\/yyyy hh:mm AM/PM")
	eruit = True
	Exit For
	End If ' close when found
	End If 'close when all recipients have been evaluated
	End If 'close when all recipients in the array have been evaluated
	If eruit = True Then
	Exit For
	End If
	Next 'Next Y, next recipient in array
	If eruit = True Then
	Exit For
	End If
	Next 'next time entry in array
	If eruit = True Then
	Exit For
	End If
	Next
	Set objApp = Nothing
	Set objItem = Nothing
	Set objAttendees = Nothing
	Set myNameSpace = Nothing
	End Sub

view raw Freeslot_finder hosted with ❤ by GitHub

A few more details

The meeting object is set in line 5, so the meeting attendees can be retrieved in line 6.

Lines 22–33 retrieve the FreeBusy information for the recipients and stores this information in an array. The FreeBusy information is provided as a character string. Each character (number), reflects the availability of this recipient:

FreeBusy States

When looping through the list of recipients, the character string that holds the availability information is added to an array:

Lines 36–41prompt the user to request the time frame within which the best slot needs to be found (1 to 4 weeks).

At line 43, the loop is initiated that loops through all slots that fit within the predefined time window. The ‘i ’variable represents a slot (of f.e. 30 minutes). ‘i’ also represents a character position in the availability string(s).

Delta is the number of slots from midnight of the day that this meeting has initially been set. This is required since the start date for FreeBusy has day-level granularity.

At line 45, the loop to evaluate the availability for all attendees is initiated (currently limited to 20 people, can be increased).

Line 45, is the core of the code because this line checks if the user is either 0 (Available) OR 1 (The user has a tentative appointment scheduled). The latter option (1) is where this Free Slot finder is different from the regular option in Outlook.

Conclusion

There is probably a lot that can be improved in this code. I can share that it has been a huge time saver for me and I hope it helps people out there as well. Free feel to provide feedback, many thanks!