Sub
ListCalendars()
Dim
objCalendarModule
As
Outlook.CalendarModule
Dim
objNavGroup
As
Outlook.NavigationGroup
Dim
objNavFolder
As
Outlook.NavigationFolder
Dim
objCalendar
As
Outlook.Folder
Dim
objOwner
As
Outlook.Recipient
With
ActiveExplorer
Set
objCalendarModule = .NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
For
Each
objNavGroup
In
objCalendarModule.NavigationGroups
Debug.Print
"['"
; .Item(i).Name;
"']"
For
Each
objNavFolder
In
.Item(i).NavigationFolders
Set
objOwner = Session.CreateRecipient(objNavFolder)
Call
objOwner.Resolve
If
objOwner.Resolved
Then
Set
objCalendar = Session.GetSharedDefaultFolder(objOwner, olFolderCalendar)
On
Error
Resume
Next
Debug.Print
"'"
; objCalendar.Name;
"'"
;
Debug.Print
" ('"
; objCalendar.Parent.Name;
"')"
Debug.Print
" Folder: "
; objCalendar.FolderPath
On
Error
GoTo
0
End
If
Next
Next
End
With
End
Sub