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 can copy all 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
Ike says
When I run the "Print Shared Calendars as One" script, my personal calendar checks itself and is included in the merge. Is there a way to keep my personal calendar from turning on?
Diane Poremsky says
I'll test it - it may be because your calendar has permissions to the shared.
Ike says
It seems like the view is being reset when the script runs. The calendars are separate, so I don't think one has permissions to the other but I could be wrong.
Kalpesh says
Hi Diane,
How can I get this data (i.e. that's being used to create Outlook Apptmts in a new "Print" calendar) to export to Excel please?
Thanks, Kalps
Diane Poremsky says
The Import / Export function should work - or create a list view with the files you need and copy and paste into Excel.
Jackie says
Can I specify a Calendar group from which the data is pulled? For example, if I have several "Room" calendars that I want to print into one, how would I adjust the macro to pull from the "Rooms" group instead of "My calendars"
Diane Poremsky says
The macro works will all groups - it looks for selected calendars, not specific groups.
Dirk says
Hi Diane,
first of all sorry for my bad english (google translator (- :)
Thanks for the post of you VBA code. Basically it's works, but the categories are not copied for me. All appointments in the "print" calendar have the same category (calendar (not in the main category list)). I am using Outlook 2016.
Can you help me?
Kind regards
Dirk
Jen Rynier says
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!
Diane Poremsky says
The macros on this page should do it.
Graham Hyman says
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?
Graham Hyman says
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
Diane Poremsky says
Is it a shared calendar, an Internet calendar or the default calendar for the data file it is in?
Graham Hyman says
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.
Graham Hyman says
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!
Graham Hyman says
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?
Diane Poremsky says
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.
Graham Hyman says
Thanks Dianne, this macro has been a lifesaver, and your support for it is amazing.
Suzy Somerville says
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?
Diane Poremsky says
What permissions do you have on the calendar? If you only have free/busy, you won't be able ot copy the events.
Jeff says
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.
Diane Poremsky says
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 & "'"
Chris Harrness says
totally screwed my outlook printing, now it will only print one calendar and ignores all the others, not good!
Diane Poremsky says
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.
tami says
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?
Diane Poremsky says
What type of email account is in outlook? Are the calendars that didn't copy over in your own mailbox or were they shared?
stan says
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?
Diane Poremsky says
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.
stan says
the calendars are stored locally (not shared).
Stan says
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
stan says
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.
stan says
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.
Diane Poremsky says
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.
Michael Dowling says
Brilliant Diane. Just changed it to set the new category the same as the appointment being copied and does just what I need. Using Outlook 365 on Win10, saved me a whole heap of work!
Irving Katz says
This macro might save me. Thanks so much.
I need to print out a daily calendar of all of our Conference Rooms and EXCLUDE my personal calendar. How would I go about this? Not having much luck, neither with the Conference Room calendars as Rooms or as Shared Calendars. Nothing shows up except my personal calendar, which is the opposite of what i want!
FYI: Exchange 2010, Outlook 2016 32-bit
Diane Poremsky says
For the personal calendar, untick it before running the macro. This one is not working for shared mailboxes? https://www.slipstick.com/outlook/combine-outlook-calendars-print-one/#shared - you need to be able to see full details (or at least the details you're copying) for it to work.
Mike N says
Is there an easy way to add a date picker to this so that the filter is set off of the dates the user chooses?
Diane Poremsky says
date picker, no, but you can ask for start and end date using input box.
Near the top of the macro - (like after on error resume next) - enter the sate in short date format - 1/11/16
sDate = input("Starting Date")
eDate = input("End Date")
in the CopyAppttoPrint sub, change Date & Date + 3 to sDate and eDate
'create the filter - this copies appointments today to 3 days from now
sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 3 & "'"
Jeff says
Great code thanks. It works but I have tried to modify in line with this. Diane. Adding sDate = input("Starting Date") where you suggested produces a syntax error under Outlook 2010. Should it be expanded by anything else? I also tried using =InputBox and managed to get it to pop up but then entering say 28/07/17 produced an empty calendar. Can you please explain?
Diane Poremsky says
>> pop up but then entering say 28/07/17 produced an empty calendar.
Add a debug.print sFilter after the filter is set and check the immediate window to verify the date - here 8/27 will convert to the short date format of 8/27/2017. Is it converting to the proper shortdate format for you?
Jeff says
Thanks Diane. As a Brit can I check. Would you enter 4 September as 4/9, 04/09 or 4/09 please?
Diane Poremsky says
any of those formats should work. right after this line - sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 3 & "'" - add debug.print sFilter. Then look at the results in the immediate window after running the macro. What date format is the filter using?if it continues to fail, you could try using these for the Date in the filter - test it with one, then the other. Format(date, "dd/mm/yyyy") Format(date, "mm/dd/yyyy")
Carolyn says
Hi Diane, This is great - I am using to combine multiple family calendars. It works great, but I can't get the categories to show on the newly created Print calendar - the option just isn't there on the Appointment ribbon or when I right click on the appointment itself (which it is for my other calendars). I can see the appointment has been allocated the category of it's 'parent' calendar when I open the appointment properties, but the 'Categories' descriptor is greyed out on this too. Can you help? Thanks
Diane Poremsky says
What type of email account is it? The data file needs to support categories - they will be white until you add them to the master list and set a color.
A Espejo says
How can I use this macro but for a certain week (next week, or this week?
I guess it can be tweaked in order to copy just the appointments on that certain week by an inputbox that asks the date of the first day (Sunday/Monday)And from then it does the rest. Is this possible?
Diane Poremsky says
This filter controls the time period:
sFilter = "[Start] >= '" & Date - 2 & "'" & " And [Start] < '" & Date + 3 & "'"for next week only, you'd use something like sFilter = "[Start] >= '" & Date + 5 & "'" & " And [Start] < '" & Date + 12 & "'"it would be possible to use an inputbox to get a date - myDate = inputbox("Start date in mm/dd/yyyy format") sFilter = "[Start] >= '" & myDate & "'" & " And [Start] < '" & myDate + 7 & "'"
Jen says
I've been trying to modify the one for shared calendars in exchange to no avail and was hoping for an assist. I am trying to pull only events labeled with a specific category from the selected shared calendars. Specifically by modifying this line:
sFilter = "[Start] >= '" & Date - 2 & "'" & " And [Start] < '" & Date + 3 & "'"I've attempted different variations of the following:
sFilter = "[Categories] = 'Blue' AND [Start] >= '" & Date - 2 & "'" & " And [Start] < '" & Date + 3 & "'"
Any thoughts?
Diane Poremsky says
Add debug.print for sFilter - what do you get?
The sample posted here looks good - did you try using Category instead of categories?
As an FYI, you can shorten this:
[Start] >= '" & Date - 2 & "' And [Start]
Jen says
The debug.print just give me "0 appointments were created" for each calendar I have selected. I've tried both [Category] and [Categories], with the same result.
Any other ideas???
Diane Poremsky says
Yeah, that's what i got with my tests last night. If you use just the categories filter, do you get any results? (I'm not, which tells me that filter is wrong.)
Diane Poremsky says
I give up. :) Categories in restrict filters can be buggy because the field supports a string of words but i only have one category assigned and its not working. However, there is an easy fix - If statement. Shoulda went with this long ago. :) If there is a chance that the category will contain multiple categories, you can use instr(1, itm.categories, 'blue') > 0 to find all categories containing the word blue (blue, black and blue, bluemoon, etc)
If itm.Categories = "Blue" Then
' create the event on the new calendar
end if
Next
Evert says
Hi Diane, you left us a great tool! Works very well for me. I am using the option for printing the current month, as you kindly spelled in one of the comments below. How can I create a combined calendar from let's say the last 3 years to 3 years forward? There are not too many items but it would help very much for tracking and making reports. Many thanks
Diane Poremsky says
This is the line that controls how many days:
sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 3 & "'"try replacing it with something like this sFilter = "[Start] >= '1/1/2013' And [Start] < '12/31/2019'"you could also do it this way, to get 3 yrs ago today and ahead 3 yrs. sFilter = "[Start] >= '" & Date - 1095 & "'" & " And [Start] < '" & Date + 1095 & "'"
Evert de Korte says
Hi Diane, thanks very much for yr reply, a bit late now with my reaction. I tested the line of code into the macro and Print does not show any merged items at all. Doies it have something to do with the 1/1/2013 in there? Thanks a lot!
Diane Poremsky says
1/1/2013 is the earliest date the code looks for - although the filter in that comment looks like it has too many ANDs. Either of these should work -
sFilter = "[Start] >= '1/1/2013'" & " And [Start] < '" & Date + 1095 & "'" or sFilter = "[Start] >= '" & Date - 1095 & "'" & " And [Start] < '" & Date + 1095 & "'"
Jennifer says
Hello! So excited to find this macro, but have run into a roadblock.
I am using Outlook 2016 with the iCloud Add In. The calendars I want to combine are in a folder called "iCloud." They seem to be standard calendars. The default Outlook calendar, and the Print one that is created, are in a separate folder, "Outlook."
When I first set up this macro, it worked perfectly. It combined everything I had selected in the navigation pane - including two from the iCloud folder and one from the Outlook folder. I was able to change the date range, too.
Then I did some housecleaning of folders to delete old items. Not sure if this had an impact, but when I tried to run it again - it didn't work. I ensured that macros are set to always be allowed, and that setting is also applied to Add Ins. I completely removed the VBS module and re-created it. Opened and closed Outlook repeatedly. Still, it now only copies from the Outlook folder, even though I have the iCloud calendars selected in the pane.
Any advice?
Diane Poremsky says
Deleting Outlook folders shouldn't have affected it - as long as you didn't remove icloud folders. if the icloud is syncing properly, you didn't delete them. :)
Try this: select the contact folders then open the VBA editor and View > Toolbar, Debug. Comment out on error resume next (add ' in from of it) Then click the step into button (or F8) and watch it step into each line. Do you get any errors?
ReneeO says
I ran this great the first time. But then I tried to digitally sign the macro and rerun it a few days later it didn't work. I deleted everything and tried again and it says that all the macros in this project are disabled. I'm using Office 2013 and don't know how to get it to work again. The Trust Center Macro Settings are set to Enable all macros (not suggested). Not sure what I can change to get it to work again.
Diane Poremsky says
You can't edit the macro after signing it - I would remove the signature (in tools, digitally sign...) and save it then restart outlook (save again if asked) - see if it works. If yes, then try signing it again.
ReneeO says
Thank you Diane - this worked perfectly
Evert says
Hi Diane, can you help me out? I can't get it to work and fix it. It comes back with Did not define Object variable or Block variable at the line: Set calItems = CalFolder.Items. I would very much like it to work, is there something missing? Many thanks!
Diane Poremsky says
That error means there is something missing from the code. First best guess is the CalFolder variable isn't getting set. Did you make any changes to the code?
Are you trying to read shared calendars?
Try stepping into the code and watch what it does with each line. When this line: Set CalFolder = objNavFolder.folder turns yellow, hover the mouse over CalFolder & objNavFolder - a tooltip should pop-up with the value of variable. Verify it is what you were expecting.
Matt K says
This is brilliant! I have copied the macro in and it is working great. Quick question. Is there a way to tag which calendar the event came from? We are using shared calendars across different teams and it would be most helpful to know from where this was coming. May thanks!
Diane Poremsky says
This sets the category name to be the account name (in the Private Sub CopyAppttoPrint() macro) - or you can use account name & calendar name if you have multiple calendars in one account. The categories will be white until you add them to the master category list.
calName = CalFolder.Parent.Name
' to use category named for account & calendar name
' calName = CalFolder.Parent.Name & "-" & CalFolder.Name
Chris Manes says
Uneducated user here. So to see in the printout which calendar an entry came from, I first have to go into my outlook category list and add each room as a new category? perhaps there is code which can just take "ParentName" and add it to the meeting title?
our scenario: facilities wants a daily list of all rooms in use so they know where/when to sanitize
Diane Poremsky says
The macro adds a category based on the calendar name - it will be white color unless you add it to the macro list.
To add color, run the macro then open an event that doesn't show a color category, click the category button and select the category 'not in master list' and select New.
Mike N says
I have this all set up and it works great. Changed it to pick up appts from 2 days back and 11 days forward to cover a 2 week period (calendar is printed on a Wednesday). The issue I am having is that it is not copying events that fall within this 2 week window if they started before the 2 week window. I hope that makes sense.
is there a way to copy the appts regardless of when they started? We use this to print out a briefing book so that the supervisor knows what's going on within the company so having all events displayed is important.
Thanks! - Mike
**UPDATE - I think I found a temporary fix. I changed the filter to read:
sFilter = "[End] >= '" & Date - 2 & "'" & " And [Start] < '" & Date + 11 & "'"
This works for now but I imagine if I have an event that doesn't end within the 2 week window, it won't show up.
Diane Poremsky says
You would need to filter for recurring appointments and filter for apt that extend multiple days. I have a macro that breaks recurring events into days but don't have one that looks at the time span.
Mike N says
I have this all set up and it works great. Changed it to pick up appts from 2 days back and 11 days forward to cover a 2 week period (calendar is printed on a Wednesday). The issue I am having is that it is not copying events that fall within this 2 week window if they started before the 2 week window. I hope that makes sense.
is there a way to copy the appts regardless of when they started? We use this to print out a briefing book so that the supervisor knows what's going on within the company so having all events displayed is important.
Thanks! - Mike
Kelli Baggott says
I cannot get the marco to work. My boss is wanting to combine two shared calendars in order to print, but keep them separate to populate and update.
Diane Poremsky says
Sorry I missed this earlier. Without knowing exactly what happens when you try it (including error messages), it's hard to say what is going on with it.
Kelli Baggott says
I'm using Outlook 2016 and the Macros isn't pulling a print file or anything. When I run it, it only causes my personal calendar to pop up with the two selected calendars. They are shared calendars, which may be the problem. If that is the problem, how do I correct it please?
Ada says
It doesn't work with me. It seems to run, but the result is nothing. Can you please help me? I am not very skilled in VBA; that might also be the cause of this problem...
Kyle says
I can't seem to get this to work on calendar appointments from Shared calendars. It works great from calendars that I create/own, but I'm needing to combine shared calendars into a merge to print off. Any advice? I saw your advice and link for working with VBA and non-default calendars, but I can't seem to figure out how to piece that script into mine to make it work.
Karen says
does this work for sharepoint calendars?
Diane Poremsky says
As long as the calendar is in your profile and is checked, yes. You need to be able to read the full appointments, so it may not work for shared calendars if you only have free/busy access, but it will work for other calendars.
stéphane says
What about shared calendar?
Diane Poremsky says
This will work with shared calendars but you may need to use code to resolve shared mailboxes - see https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ for a code sample
David says
This macro works great for me with no issues. I would like to edit the filter on this macro to filter for the current month so that the print calendar would display all appointments from November 1, 2015 to November 30, 2015 for example. Any recommendations on what to use to make this change from "current date plus 3 days" to "start of current month to end of current month"?
Diane Poremsky says
You can replace Date with the DateSerial function - this will get from the 1st to the last day of the current month.
sFilter = "[Start] >= '" & DateSerial(Year(Date), Month(Date), 1) & "'" & " And [Start] < '" & DateSerial(Year(Date), Month(Date) + 1, 0) & "'"
Gilbert says
Hi Diane, Excellent Macro and hugely appreciated too...
I have one thing to ask, how do i stop this picking up my own calendar as well as the intended calendars please?
Thanks!
Ama says
I need to print times and meeting titles from 14 Outlook 2013 32-bit calendars onto a one-page monthly view hardcopy on a weekly basis. At present, I manually type them into a Word calendar template and shrink the fonts until everything fits on one page. This is time consuming, and it seems like there should be a better way. I tried your macro, which works but for some reason I get 3 copies of each calendar instead of one in my "print" calendar. Any ideas?
Diane Poremsky says
Well, that definitely shouldn't happen. Are the calendars listed in more than one group in the left pane?
Frank says
I got this too. The error is "Your server administrator has limited the number of items you can open simultaneously. Try closing messages you have opened or removing attachments and images from unsent messages you are composing.
Diane Poremsky says
the macro isn't opening anything, so its an odd error to get. Did the macro ever work? I know it will error if you have a bunch of the print folders in the deleted items folder.
Dave says
Thank you. I just cant seem to find where it is happening. Or how to catch what error is occurring.
Diane Poremsky says
I changed the dates to use start - 30 and + 180 - and selected 3 calendars. I have 1097 items in the print calendar. It took a second or two to run, no errors. Ran it a second time and got 95 items, mostly from one calendar.
one thing to try is replacing these lines with code that creates new events instead of copies.
Set newAppt = itm.Copy
newAppt.Categories = calName
newAppt.Move printCal
I switched to this code and while it took a lot longer to run, it created all of the events and did not add copy to the subject
Set newAppt = printCal.Items.Add(olAppointmentItem)
With newAppt
.Subject = itm.Subject
.Start = itm.Start
.End = itm.End
.Categories = calName
.Save
End With
Dave says
For some reason, the "Copy:" string is not added to some entries (appointments that I own!) until after the move. At least that what it seems. So I wrote a module to replace them later in the process by going through all of the calendar entries. One note is that I needed to make sure to close each entry (appt.Close (olSave)) For the changes to take place.
Now the only problem I have left is that the code is not doing all entries. It seems to be stop at first after about 100 entries (Im trying to do several months). I don't know if something is causing it to run out of memory (ie not closing something) but it is sort of frustrating. Id like to go (-30 to +180) which is a lot of entries. Running it a second time causes it to stop even sooner.
Diane Poremsky says
It sure sounds like something is not closing and it's eating up memory but the code looks good. I'll take another look at it over the weekend. (I'm on the road with only my ultrabook.)
Dave says
Why does to work "copy" appear in some of the new appointments? but not in others? I would like to have things the same as before. I removed the category setting so that the categories are the same.
Webmaster says
Copy is added to meetings you move to a new calendar.
David Doermann says
Thanks. I'm trying to remove them because there is limited print space. I'm using something like
newAppt.Subject = Replace(newAppt.Subject, "Copy: ", "")
but it appears copy is inserted in other places as well. For some entries it works (ie ones others have added to the calendar) but it does not for the ones I have added (very strange).
Any ideas?
Diane Poremsky says
that is definitely strange. Is it in those appointments as "Copy: " ? if you use more replaces to remove other forms ("Copy:", "Copy") are they removed?
Dave says
Perhaps it has something to do with recurring appointments outside of the window?
Diane Poremsky says
No, it shouldn't because of the recurring appointments. It's because the meetings were copied.
Maria says
Hi Diane,
Thank you for this wonderful code; it's made my work easier! Two questions:
1. Is there a way to avoid printing/show appointment details?
2. How can I remove the loop around code? I only need it to select calendars from one group ("other calendars) but not all of them. Currently, it loops around and checks all of my calendars and prints "my calendar" AND "other calendars" (there are 13 in this group; these are the only ones I need)?
Many thanks!!
Diane Poremsky says
rather than copying the appointments, you'd need to create a new apt using just the fields you wanted.
this line does the loop: Set objNavFolder = objGroup.NavigationFolders.Item(i) - if you only wanted 1 group you would replace 'i' with the group number. if other calendars is the second group, its 2.
Nicole says
Hi Diane,
Were you able to test the fields to see what we need in the macro to grab all week long and all recurring?
Diane Poremsky says
a week duration is [duration] = '168 hours'
to get only recurring use [recurring] = 'true'
to get both, you need to use OR to link them together.
Nicole says
ok, got it! and how do i pull the appts. that are one week long and also the reaccurring appointments?
Diane Poremsky says
The week long ones would be
sFilter = "[Start] >= '" & Date & "' AND [End] = '" & Date + 7 & " And [Start] < '" & Date + 3 & "'"i'll have to test some fields to see what we need to get all week long appointments and all recurring.
Nicole says
Diane, how do I change the date to include all appts. for the next three years?
Diane Poremsky says
This part sets the date period, with the end date in bold
'create the filter - this copies appointments today to 3 days from now
sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 3 & "'"
you'd need to change the 3 to 1095 to use 3 years.
Julius Wilson says
This one errors out at
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 <= '" & 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 = itm.Copy
newAppt.Categories = calName
newAppt.Move printCal
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
Diane Poremsky says
What is the error message? Do you have these lines at the top of the module?
Dim CalFolder As Outlook.Folder
Dim printCal As Outlook.Folder
Are you combining shared calendars? if so, do you have permissions to view the appointments?
I'm assuming the missing lines between these two is a typo -
Set calItems = CalFolder.Items <= '" & Date & "'" & " And [Start] < '" & Date + 3 & "'"' Apply the filter
Julius Wilson says
I found a different post that doesn't err out.. but it doesn't work, no errors.. see below.
The one below combines my view in the calendar but doesn't print the shared calendar... I have a shared calendar with my supervisor.. I'd like to be able to print both at the same time.. I believe others have requested to be able to do the same.. My other issues are
* I really don't know how to access this without pressing Alt+F11 every time I want to print.. * And when I export it (Windows 7) it tries to save/export a *.bas file to my Windows profile. I see the option "File/Save/ VbaProject.OTM...
Sub SelectCalendars()
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
Set Application.ActiveExplorer.CurrentFolder = Session.GetDefaultFolder(olFolderCalendar)
DoEvents
Set objCalendar = Session.GetDefaultFolder(olFolderCalendar)
Set objPane = Application.ActiveExplorer.NavigationPane
Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
With objModule.NavigationGroups
Set objGroup = .GetDefaultNavigationGroup(olMyFoldersGroup)
' To use a different group
' Set objGroup = .Item("group name")
End With
For i = 1 To objGroup.NavigationFolders.Count
Set objNavFolder = objGroup.NavigationFolders.Item(i)
Select Case i
' Enter the calendar index numbers you want to open
Case 1, 3, 4
objNavFolder.IsSelected = True
' Set to True to open side by side
objNavFolder.IsSideBySide = False
Case Else
objNavFolder.IsSelected = False
End Select
Next
Set objPane = Nothing
Set objModule = Nothing
Set objGroup = Nothing
Set objNavFolder = Nothing
Set objCalendar = Nothing
Set objFolder = Nothing
End Sub
Diane Poremsky says
What happens when you try to print it? (It doesn't automatically print.) To use it without opening the vba editor, customize the ribbon (File, options) and add the macro as a button on the ribbon (end of article).
When you export a macro, it will create a bas file. if you want to share it or save a copy, you can copy and paste instead - into notepad, onenote, or email.
Julius Wilson says
Can someone provide a complete macro that can be pasted into the VB editor? These posts are getting to be a bit confusing.. I'm trying to print multiple (2) shared calendars on one page...
Diane Poremsky says
What happens when you use the macro in the article?
Jeffrey Lewis says
Great macro. It ran fine except that the Print calendar does not have my recurring calendar entries. I checked through the blog history and did not see this issue mentioned. Any advise?
Diane Poremsky says
I think it worked correctly before I switched from creating a new appointment to copying the current one. :( If you comment out calItems.IncludeRecurrences = True, it'll copy the entire recurring event. Not a perfect solution, but it will get everything while i look at the code.
Diane Poremsky says
Try /macros/copy-print-recurring.txt and see if it works better.
Mera says
Hi Diane
I hope this thread is still live, have they installed this facility back in Outlook 2016 yet?
Thanks SO much for an amazingly useful macro.
I went through all the comments and tried to incorporate all of them to get the perfect tweak for what I need.
The recurring code above works, but duplicates everything because it does not delete the PRINT calendar it creates, though I can see it in there in the code, something is not working, so it does not delete.
Also I am still not able to get all the Appointment categories to accurately copy across.
For example, I work in 2 GP practices. I colour apts for one in purple, the other in Green. Then I put social stuff in yellow, and a couple of other bits in diff colours eg my courses in orange.
If I could have the code do the above ie
1) delete the print calendar each time the macros is run so there are not duplicates
2) have accurate copy across of the appointment colour, ie the entire block of the apt if it were from 1pm -3pm blocked in one colour, then that would really help.
3) When/if the code does copy across the colours does it copy across custom colour too? when you are in calendar mode you can go into colour wheel and select exact colour you like, will it copy this across too?
Really hope to hear from you soon Diane.x
Regards
Mera
Diane Poremsky says
1. Do you get any error messages? If there are more than 10 print calendars in the Deleted items folder, it won't delete the folder. Empty deleted items to get rid of the calendars then the code should work.
2. It should be accurate now. As for categories, if you want to copy the category, use
.Categories = itm.categories
if you want to add the category for the calendar name, use
.Categories = itm.categories & calName ' might need itm.categories & ";" & calName
3. If the category exists in your mailbox and has the same color as the original mailbox, the colors will show .
Rhonna says
Grrr. For Step 2. "Copy and paste the macro into the new module."
Does the macro code start at
1. "Dim CalFolder As Outlook.Folder
2. "Sub PrintCalendarsAsOne()"
or are we supposed to include the Yellowbox information?
"... calName = CalFolder.Parent.Name & "-" & CalFolder.Name"
Sorry to be so naive, but for average user just trying to print multiple calendars for Outlook 2013 this is HUGE learning curve to learn via Visual Basic Editor w/in Excel and know coding for macros.
Thanks!
Diane Poremsky says
You'll paste just the macro code that is in the code block (in Time New Roman font), not what is in the yellow block. The yellow block suggests ways to change the macro.
A quickie video is here - https://docs.google.com/file/d/0B22iPSInt7uxcGN1RDN2OEh4bWs
Bernd Hohenester says
Hello Diane, i tried the macro using Outlook 2013 on Win 8.1. It throws no errors, the print-calendar is created but no items are filled in. How may i send you a screen shot of my calendars?
Thanks a lot for helping me.
Sincerely
Bernd
Diane Poremsky says
Upload it to onedrive, dropbox etc and post a link here.
Do you have appt on the calendars due within the time period? The code only copies the next 3 days:
sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 3
Jennifer says
Hi Diane -
I'm getting the same error as Carlos above... re: "Set calItems - CalFolder.Items"
My VB error says:
Run-time error '91':
Object variable or With block variable not set
I do have exchange 365 if that makes a difference for anything.
Thank you,
Jennifer
-------------------------------------------------------------------------------------------
Diane Poremsky says
What types of calendars are selected? If the calendar is a shared calendar, I don't think the code works (but I'll need to test it again to refresh my memory :)).
Tony Lopez says
Hi, I am getting this same error message and cannot seem get the macro to run properly. The calendars I have are not shared calendars as I saw that having them with this macro might cause problems. Any help would be appreciated. Thanks
Diane Poremsky says
Are you clicking in the PrintCalendarsAsOne before running the macro? The CopyToPrint macro is a "helper macro" and can't be run from the editor - it's called by PrintCalendarsAsOne macro.
If that is not the problem, show the Debug Toolbar and Step into the macro so you can see where it errors.
Right click on the Toolbar area and choose Debug. Click in the PrintCalendarsAsOne macro then click the Step into button. (F8 is the Step into shortcut key.)
mrsadmin says
Hi Diane, I love this macro, makes my juggling a lot easier.
I'm having the same problem as Scott Beecher, the code works great, but I can't see where to put the new code in for the category colours to use the calName.
I've copied exactly as you wrote the macro, I haven't edited, I just can't figure out where to add in the new snippet.
Cheers,
Diane Poremsky says
Hmm. I don't see it either... in CopyAppttoPrint macro, add the categories after the copy is created and before it's moved. (I updated the code to make it more efficient and didn't add the category back.)
Set newAppt = itm.Copy
newAppt.Categories = calName
newAppt.Move printCal
if you want to keep categories that existed before, use
newAppt.Categories = calName & "," & newAppt.Categories
or
newAppt.Categories = newAppt.Categories & "," & newAppt.Categories
Scott Beecher says
Love the macro! Is it possible to keep the color formats of the original calendars when they are copied over to the new PRINT calendar?
Diane Poremsky says
Category colors or the calendar tab color? You can use the appointment categories by changing this line:
.Categories = calName '& ";" & itm.Categories
to
.Categories = itm.Categories
or
.Categories = itm.Categories '& ";" & calName
Dan T. says
Thanks for this tool, Diane. It's working as intended, but I still don't see the .Categories = calName (...) to replace as you mentioned.
Am I missing something?
Johne Smith says
Were you able to figure out why it only puts in my calendar only in the print calendar?
Diane Poremsky says
Are they in mailboxes opened in your profile or in shared mailboxes where only the calendar is open in your profile? I haven't been able to make it work when only the calendar is shared - the mailbox needs to be open in the profile (either as an account or as a secondary mailbox to your account).
Johne Smith says
AH ok ic. They are shared. Thanks for the reply!!
muffitt says
I have several sites with events on that i would like to import into a calander where i can see all of the event s together. is this possible
Diane Poremsky says
Yes, it is possible as long as you can get the calendars in a format Outlook can import. (The macro on this page probably won't help you because the calendar needs to be in Outlook.)
muffitt says
so how would i do this, then. there's about 20 sites with horse events on a diary. Each site is a different venue.
I would like to have them all automatically put on once calandar so i dont have to jump to each site in order to look to see what event i want to attend or what is on
Diane Poremsky says
These are web sites? If they have a calendar you can subscribe to, you can subscribe to it in Outlook, using File, Account Settings, Internet Calendars. Copy the url and paste into the New dialog on the Internet Calendars tab. It won't put them on the same calendar, but you can overlay them in outlook.
Carlos Novas says
I am having difficulties running this macro. When I run the macro in VBA I get an error related to the line: Set calItems = CalFolder.Items
Any help figuring this out would be greatly appreciated
Diane Poremsky says
Without knowing what the error is, it's hard to say, but I'm guessing it is because the CalFolder object is not valid for some reason. It's set in the first macro in this line:
Set CalFolder = objNavFolder.folder
Lu Phillips says
How do you pick up the other calendar names in the macro? Exactly how is this added to the code?
Diane Poremsky says
The macro looks to see which calendars are selected and displayed and copies appointments from those calendars only.
Johne Smith says
Thanks for the reply. I have multiple selected and it still only copies mine. all of my calendars are under My Calendars for me. They aren't in different groups.
Sue Burton says
Thank you so much for posting this code. This has been a brilliant help.
Tereese says
Hi Diane. Thank you so much for this code!! One question though, how do you use the category colors that match the calendar color? The categories in my print calender are all one color.
Diane Poremsky says
I assigned the colors to the categories. I don't know if its possible to grab the color from the calendar but will check. If i can the macro can add the category to the master list.
Tereese says
Thanks. I have several shared calenders as mailboxes under my default calender profile and I only want those calenders pulled to the print calender. I select the calenders that I want, but when I run the macro it always pulls in my default calender even though I don't have it selected. How do I only pull the calenders I selected? I tried adding the case statement from the "Select multiple calendars in Outlook" but it's not pulling correctly.
Diane Poremsky says
I'll check the code and make sure it's not picking it up automatically. (It is picking up the default calendar but I'm not sure why. yet.)
Diane Poremsky says
Ok... try removing this line after it creates the print calendar. I think the doevents can be deleted to (it basically adds a delay)
Set Application.ActiveExplorer.CurrentFolder = objCalendar
Tereese says
Thanks!!! Removing that line helped
Jim says
Does this work with shared calendars? I seem to only be picking up my own calendar.
Diane Poremsky says
As long as the calendars are in your profile and are selected, it should work. Oh, are they in a different group? It uses the default group. I'll add a loop to check a second group.
Diane Poremsky says
Replace the original block with this (between Set objModule and all of the set = Nothing's) - I'll update the code to use it.
Dim g As Integer
With objModule.NavigationGroups
For g = 1 To .count
Debug.Print g
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
Jim says
Thanks Diane.
It's still not working for me. My other calendars are in a "Shared Calendars" group.
I can take a screen shot and send it to you if you think that might help.
Diane Poremsky says
do you get any error messages? Are any appointments copied to the new calendar?
Jim says
No errors. It copies my calendar (the main calendar). Can I send you a screen shot?
Diane Poremsky says
Yes, you can send me a screenshot - diane at slipstick
Pomeranian Club Central VA says
I am experiencing the same problem as Jim. I get the End/Debug error when it gets to here: Sub PrintCalendarsAsOne()
Pete Maryan says
I'm trying to use this macro in Outlook 2013 32bit, for the exact purpose of printing out a calendar derived from all rooms in a location.
I've copied the code above into a Module, but it keeps failing to run successfully. I've created a new calendar called Print and I've selected my room calendars.
When I run the macro for PrintCalendarsAsOne it breaks at: Set printCal = Session.GetDefaultFolder(olFolderCalendar).Folders("Print")
When I run DeleteApponPrint it breaks at: Set calItems = printCal.Items
Any suggestions?
Diane Poremsky says
The Print calendar is located under the Default calendar? What does the error say when it hits that folder?
Diane Poremsky says
As an FYI, i updated the macro to create the Print calendar automatically.