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 macros that I tweaked to copy the appointments from the selected calendars were originally published at Select multiple calendars in Outlook and Copy Recurring Appointment Series to Appointments.
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. Updated October 27 2015 to create new items on the Print calendar instead of copying them. It's slower but avoids "copy:" added to meeting subjects and seems to work better when there are a lot of items to copy. The code is only using the subject, start and end dates from the original appointment but other fields can be added. August 25 2016: Added code to delete the Print calendar from Deleted Items (otherwise it errors if there are more than 10 Print calendars in the Deleted Items folder.)
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
To use the macro, paste it into the VBA Editor then click in PrintCalendarsAsOne macro and click Run (F5). If you want to run it using a button on the ribbon or QAT, select the PrintCalendarsAsOne macro and add it to the ribbon or QAT.
Dim CalFolder As Outlook.Folder Dim printCal As Outlook.Folder ' Run this macro 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 objDeletedItems As Outlook.Folder Dim objDeleteFolders As Outlook.folders 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 objDeletedItems = Session.GetDefaultFolder(olFolderDeletedItems) Set objDeleteFolders = objDeletedItems.folders objDeleteFolders.Item("Print").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 Private 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 .Subject = itm.Subject .Start = itm.Start .End = itm.End .ReminderSet = False .Categories = calName .Save End With 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
Print Shared Calendars as One
This version of the macro works with Shared Calendars in Exchange that are open in your profile. This includes Resource calendars as well as other user's calendars. (It also works with calendars in your mailbox and in shared mailboxes open in your profile as a secondary mailbox.)
If you don't have read permission on the calendar, events will not be copied to the Print calendar.
Dim CalFolder As Outlook.Folder Dim printCal As Outlook.Folder Dim nameFolder ' Run this macro Sub PrintSharedCalendarsAsOne() 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 Set nameFolder = objNavFolder Dim NS As Outlook.NameSpace Dim objOwner As Outlook.Recipient Set NS = Application.GetNamespace("MAPI") Set objOwner = NS.CreateRecipient(nameFolder) objOwner.Resolve If objOwner.Resolved Then Set CalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar) End If 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 Private 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 On Error Resume Next StrName = " - " & CalFolder.Parent.Name calName = nameFolder & StrName ' 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 - 2 & "'" & " 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 .Subject = itm.Subject .Start = itm.Start .End = itm.End .ReminderSet = False .Categories = calName .Save End With 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
Utilities to Print Multiple Calendars
If you prefer using a utility, the following utilities can print multiple calendars together on one page.
Tools
The Calendar Printing Assistant allows you to print and customize your calendar information. It includes many often-requested printing options, including multiple calendars in one view and customizations such as fonts, colors and images. It includes ready to use templates. Additional templates are available from Microsoft: Templates for Calendar Printing Assistant For Outlook 2007 and Outlook 2010 (32-bit). |
|
Printable customized PDF calendar directly from outlook. - Print multiple calendars as overlay or side by side. - Year, Week or Daily view. - Select timeframe and categories to print. - Yearly calendar with company name |
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
HI,
I have used microsoft calendar printing assistant for years to combine several calendars that are set up in my outlook account. Just recently this has stopped working. I am looking to combine the calendars, and then print them in a weekly list view. Do you know of any way that I could accomplish this?
Thanks so much!
The macros on this page should do it.
Hi Dianne, the macro has been running beautifully till just recently, and I don't think I've made any changes to Outlook. No matter what combination of calendars I use the macro produces a Print calendar with no appointments in it. Any ideas?
AN update: this is still not working but there is a strange behaviour that might be a clue. After the macro runs all calendar are selected except one, which is presented in List view. It is always the same calendar, and it is not the calendar for the default account
Is it a shared calendar, an Internet calendar or the default calendar for the data file it is in?
I have 4 calendars open: calendar in default (IMAP) account, calendar shared from another Office 365 user's account, 2 ICS calendars added as "from internet". It doesn't matter what view the macro starts in but when it is done I have a calendar opened in list view from an account that is neither the default or one of the calendars that was initially selected. The print calendar is added but has not items in it. I get the same results with both versions of the macro.
It is so infuriating because as far as I can tell nothing is different to when the macro functioned perfectly.
I have since uninstalled/reinstalled Outlook and am using the Shared Calendars version of the macro and it is working properly again so I guess this issue is closed. Thanks!
The macro has stopped working again, and, as far as I know, nothing has changed.
The calendar setup on which I try to run the macro is: A calendar in my default account (O365), a shared calendar on that account from another O365 account, and an ics link calendar.
I have all three selected and run the macro (both versions) and have a blank Print calendar generated in a different O365 account in my Outlook with the calendar name for that account highlighted in the folder panel but nothing in the viewing pane (I have attached a snapshot, the yellow highlights are the 0365 calendars and the green is the ics). Any clues?
Are you using that view when you run the macro? The macro runs on the selected calendars - the ones checked and showing on the screen.
Thanks Dianne, this macro has been a lifesaver, and your support for it is amazing.
Hello,
This macro is fantastic - but there is one shared calendar that no matter what I do wont show up in the print calendar - any ideas?
What permissions do you have on the calendar? If you only have free/busy, you won't be able ot copy the events.
Thanks indeed Diane. The script works perfectly for me but if course I want to go further by introducing an input box to set an appropriate Monday start date. Tried using 'sDate=input("Starting Date") ' near the top of the script but it produces 'syntax error'. Also of course changing Date to sDate as you specified further down in the script. Should there be more to the 'sDate=input("Starting Date") ' line or should I somehow be using InputBox? I tried that but struggled.
Sorry i missed this earlier - i typoed the code, it should be inputbox, not plain input. Sorry about that.
At the very top, with
Dim CalFolder As Outlook.Folder
Dim printCal As Outlook.Folder
add Dim's for the dates -
Dim sDate As Date
Dim eDate As Date ' if using a user-defined end date
After the list of Dim's in Sub PrintCalendarsAsOne()
add
sDate = InputBox("Starting Date")
'eDate = InputBox("End Date") ' if using
change sFilter as needed
sFilter = "[Start] >= '" & sDate & "'" & " And [Start] < '" & eDate & "'" sFilter = "[Start] >= '" & sDate & "'" & " And [Start] < '" & sDate + 3 & "'"
totally screwed my outlook printing, now it will only print one calendar and ignores all the others, not good!
The macro doesn't affect printing - it just creates a new folder with copies of events from all calendars so you can print a combined calendar. it wont affect your ability to select a different calendar for printing.
Love this and got it to work - sort of. Some of the other calendar appointments are brought into the Print calendar, but others are not. I cannot seem to find a common reason. Suggestions?
What type of email account is in outlook? Are the calendars that didn't copy over in your own mailbox or were they shared?
I only get the first calendar in my group (personal calendar) even though it is not ticked. The ones I tick do not copy. All calendars are in same calendar group on Outlook2013. Where do I need to start?
Are the calendars from shared mailboxes and only the calendar is in your profile? If so, you need to use the second macro on the page.
the calendars are stored locally (not shared).
I did a bit of different testing. It appears that the default "calendar" for IsSelected is "true" on all the computers I've worked on (3pcs running MSO 2013).
I have several workarounds so no problem...
1) don't use the default "calendar"
2) put a compound "if" clause for the IsSelected to ignore "calendars"
Stan
I tried this on a different computer with copied calendars (export/import). I have the default calendar empty, select the ones I want to copy together to "print". They are in the default "my calendar" group and nothing gets copied to the "print" (presumably because my default calendar is empty). I have tried both macros.
Ok more progress... 1) the calendars need to be in the default calendar group (I need to figure out how to change this by looking at the other macros, they were not on the other computer).
2) recurring items (most of these items are recurring) had a start date in the distant past. I changed the sFilter to a very old start point.
All works now, with some tweaking to do.
Hmm. This should grab any that are checked.
With objModule.NavigationGroups
For g = 1 To .Count
Set objGroup = .Item(g)
it goes through the groups and then code checks each calendar in the group.
Try adding debug.print objegroup.name after setting the group - then check the immediate window (View menu) to see if it lists each group.