I'm often asked if there is a way within Outlook to print a single calendar containing the appointments from every calendar in the profile. Although Outlook doesn't have this ability built in, you could copy all of the appointments to one calendar and print, or use the Calendar Printing Assistant or third party print utilities.
Note: The calendars need to be in your profile as mailboxes, not opened as shared calendars. This will not work with shared calendars that display only Free/Busy.
Copying appointments from list view is fairly easy, if monotonous, but a macro makes quick work of it. This question on Outlook forums finally nudged me to write a macro that would do it: combine 24 meeting room calendars in to 1 single list.
The result is a set of macros pulled from macros previously published here at Slipstick. (Not a lot of writing involved!)
The macro deletes the calendar called Print, if it exists, then creates a new calendar folder named Print , then checks to see if one or more calendars are selected in the navigation pane, and if so, it copies the appointments to the Print calendar.
My sample copies appointments for the next 3 days, but you can add (or subtract) from Date to include any period. The data file name (as seen in the folder list) is added to each appointment as a category, so you know which calendar each appointment is from (I use category colors that match the calendar color). Recurring appointments are copied to the Print calendar as single appointments.
After running the macro, go into File, Print, click Print Options and select the Print calendar then click Print.
Note: this code was updated on July 15 2014 to create the Print calendar automatically. If the print calendar exists, it deletes it and recreates it, otherwise it creates it. It was updated on July 29 2014 to check each group for selected calendars.
Calendars in Exchange Public folders are categorized using "Favorites", not their actual folder name. You can include the calendar name when creating the category: calName = CalFolder.Parent.Name & "-" & CalFolder.Name
Dim CalFolder As Outlook.Folder Dim printCal As Outlook.Folder Sub PrintCalendarsAsOne() Dim objPane As Outlook.NavigationPane Dim objModule As Outlook.CalendarModule Dim objGroup As Outlook.NavigationGroup Dim objNavFolder As Outlook.NavigationFolder Dim objCalendar As Folder Dim objFolder As Folder Dim i As Integer Dim g As Integer On Error Resume Next Set objCalendar = Session.GetDefaultFolder(olFolderCalendar) Set printCal = objCalendar.Folders("Print") printCal.Delete Set printCal = objCalendar.Folders.Add("Print") Set Application.ActiveExplorer.CurrentFolder = objCalendar DoEvents Set objPane = Application.ActiveExplorer.NavigationPane Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar) With objModule.NavigationGroups For g = 1 To .count Set objGroup = .Item(g) For i = 1 To objGroup.NavigationFolders.count Set objNavFolder = objGroup.NavigationFolders.Item(i) If objNavFolder.IsSelected = True Then 'run macro to copy appt Set CalFolder = objNavFolder.folder CopyAppttoPrint End If Next i Next g End With Set objPane = Nothing Set objModule = Nothing Set objGroup = Nothing Set objNavFolder = Nothing Set objCalendar = Nothing Set objFolder = Nothing End Sub Sub CopyAppttoPrint() Dim calItems As Outlook.Items Dim ResItems As Outlook.Items Dim sFilter As String Dim iNumRestricted As Integer Dim itm, newAppt As Object Set calItems = CalFolder.Items If CalFolder = printCal Then Exit Sub End If ' Sort all of the appointments based on the start time calItems.Sort "[Start]" calItems.IncludeRecurrences = True calName = CalFolder.Parent.Name ' to use category named for account & calendar name ' calName = CalFolder.Parent.Name & "-" & CalFolder.Name 'create the filter - this copies appointments today to 3 days from now sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 3 & "'" ' Apply the filter Set ResItems = calItems.Restrict(sFilter) iNumRestricted = 0 'Loop through the items in the collection. For Each itm In ResItems iNumRestricted = iNumRestricted + 1 Set newAppt = printCal.Items.Add(olAppointmentItem) With newAppt ' delete any lines you don't need to include .Start = itm.Start .End = itm.End .Subject = itm.Subject .Body = itm.Body .Location = itm.Location .AllDayEvent = itm.AllDayEvent .Categories = calName '& ";" & itm.Categories .ReminderSet = False End With newAppt.Save Next ' Display the actual number of appointments created Debug.Print calName & " " & (iNumRestricted & " appointments were created") Set itm = Nothing Set newAppt = Nothing Set ResItems = Nothing Set calItems = Nothing Set CalFolder = Nothing End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s 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.
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