Printing Mulitple Calendars

Not open for further replies.

Jackie Orona

New Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server
Hello Diane,

I have been tasked with finding a way to print our Conference Room calendars in Outlook 2013. I have been successful getting your SelectCalendars code to work. I am able to select all of the calendars in my ConfRms calendar group. Although it still selects my main calendar too.

When I try to run your following code it errors on the CopyAppttoPrint sub at Set calItems = CalFolder.Items.

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")
Set printCal = objCalendar.Folders.Add("Print")

Set Application.ActiveExplorer.CurrentFolder = objCalendar

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

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 = itm.Copy
newAppt.Categories = calName

newAppt.Move printCal

' 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

Any help would be appreciated.

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
S Appointment font size when printing only changes Tasks' font Using Outlook 0
A How to use calender printing? Using Outlook 1
M Printing Appointments Using Outlook 1
M Calendar daily Appointments and printing Using Outlook 0
T Printing from Outlook is now defaulting to "Shrink to Fit"! Using Outlook 5
W Automatically open attachments without automatically printing them Using Outlook 0
S Outlook 2007 printing wrong email address at top of page Using Outlook 8
snissen Printing foreign language messages Using Outlook 1
L printing contacts Using Outlook 1
A How to get rid of Contacts field when printing emails? Using Outlook 0
Diane Poremsky Printing Calendars with Color Categories Using Outlook 0
D VBA macro printing attachments in shared mailbox Outlook VBA and Custom Forms 1
D Printing Contacts Using Outlook 2
C Printing tasks with multiple categories Using Outlook 5
P Printing PDF attachments of Outlook message attachments Outlook VBA and Custom Forms 2
S macro for opening attachments and printing Using Outlook 1
P printing weekly calendar in Outlook 2013 cuts days of week off Using Outlook 1
M Calendar Printing Assistant Hangs only on specific Template Using Outlook 2
G booklet printing in outlook 2007 Using Outlook 1
W Meeting printing background fields Using Outlook 0
K calendar printing Using Outlook 1
M Outlook 2013 is printing headers only Using Outlook 4
B Printing Advanced Search Output Screen Using Outlook 5
S So Disappointed in Calendar Printing Assistant!! Using Outlook 2
D Printing Attachments Automatically in Outlook 2010 Using Outlook 1
F Printing all day events only Using Outlook 3
J outlook printing Using Outlook 2
J Printing Calendar in Outlook 2013 Using Outlook 0
C Printing Outlook Form Controls via Word Using Outlook 11
E Printing Using Outlook 1
C Custom .oft / Printing Issue(s) Using Outlook 1
K Printing & Saving Outlook Contacts Using Outlook 3
P Printing Issues in Outlook 2007 Using Outlook 1
E Outlook 2010 network printing problems Using Outlook 4
L Auto printing unread email + attachments in Inbox - Outlook 2010 - (New user) Using Outlook 1
I Printing Using Outlook 0
E Monthly Style Calendar Printing Using Outlook 6
S How to remove tracking from printing - outlook 2010 Using Outlook 4
P Printing calendar (work week) with numerous (i.e. >7) all day events... Using Outlook 3
A Outlook CPAO - Printing Monthly calendar with only all day events or catergory Using Outlook 2
E Adding Start and End Time to Daily View in Calendar Printing assistant Using Outlook 1
M Outlook 2010 task line printing Using Outlook 1
S Printing Selected Date Range in Monthly Style Using Outlook 1
S Does Printing Assistant Work with Windows 8 and Office 10? Using Outlook 1
A outlook printing assistant Help editing template Using Outlook 3
S Printing Category Key on Calendar Using Outlook 1
P Printing Issue on Calendar Printing Assistant Using Outlook 0
W Calendar Printing with Outlook 2010 (64 bit) Using Outlook 1
R printing fields in addresses Using Outlook 1
S Nor printing to Epson printer Using Outlook 3

Similar threads