Anyone who has a lot of meetings can understand this user's request: the ability to limit the number of meetings users can schedule with him each day by making Free/Busy appear busy.
The solution: count the number of Busy periods. If it's more than the desired hours, create an all-day busy appointment to block the day off.
The macro will count Busy, Tentative, and Out of Office times within the working hours set in the macro.
In my screenshot, it does not count the tentative Focus time because it starts counting Free/Busy at 9 AM.
To use, run the macro every day or automate it using a reminder. The macro does not check to see it created a blocking event for a date previously, so you may end up with duplicates.
This macro is built from the macro at the end of this article:
Sub BlockMoreCalendarAppts() Dim myAcct As Outlook.Recipient Dim myFB As String Dim tDate As Date Dim d As Long Dim i As Long Dim test As String Dim oAppt As AppointmentItem ' it needs to know whose FB to check Set myAcct = Session.CreateRecipient("diane@slipstick.com") ' days to check For d = 0 To 14 tDate = Date + d ' use start of working day or there about ' false counts tenetive and oof as busy myFB = myAcct.FreeBusy(tDate + #9:00:00 AM#, 5, False) ' this gets the # of 5 min periods before the start time i = (TimeValue(tDate + #9:00:00 AM#) * 288) ' only count free busy for 8 hours from start + at least 1 additional 5 min period ' # of min in working day / 5 ' skips busy times in the evening test = Mid(myFB, i, 485 / 5) CountOccurrences = UBound(Split(test, "1")) 'busy, oof or tentative CountO = UBound(Split(test, "0")) ' free 'round to hours for subject times = Round(((CountOccurrences * 5) / 60), 2) ' create all day busy event ' there are 12 5 minute periods per hour ' 60 = 5 hours If CountOccurrences >= 60 Then ' default calendar Set oAppt = Application.CreateItem(olAppointmentItem) With oAppt .Subject = times & " hours of appt today" .Start = tDate .ReminderSet = False .Categories = "Full Day" .AllDayEvent = True .BusyStatus = olBusy .Save End With End If ' check next day Next d End Sub
How to use the macros on this page
First: You need to have macro security set to the lowest setting, Enable all macros during testing. The macros will not work with the top two options that disable all macros or unsigned macros. You could choose the option Notification for all macros, then accept it each time you restart Outlook, however, because it's not as easy to sneak macros into Outlook (unlike in Word and Excel), allowing all macros is safe, especially during the testing phase. You can sign the macro when it is finished and change the macro security to notify.
To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Macros that run when Outlook starts or automatically need to be in ThisOutlookSession, all other macros should be put in a module, but most will also work if placed in ThisOutlookSession. (It's generally recommended to keep only the automatic macros in ThisOutlookSession and use modules for all other macros.) The instructions are below.
The macro on this page should be placed in a module.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
Hi Diane. This macro looks like exactly what I've been looking for. Unfortunately, when I try to run it I get the error "cannot load free/busy information". I'm using Outlook for Microsoft 365 enterprise. How can I work around this? Thanks!
This is a great time saving macro for someone in a setting where they receive many meeting requests and need to âstop themâ once a certain amount of their day is booked. Thanks Diane!