Listing calendar names of all active calendars - vbscript

Question

I'm trying to list all the calendar names in Outlook (my own and shared calendars).
dim oApp
dim oNameSpace
dim oFolder
dim fChild
dim fParent
dim sNames
fChild = Folder
fParent = Folder
sNames = ""
set oApp = CreateObject("Outlook.Application")
set oNameSpace = oApp.GetNamespace("MAPI")
for each fParent in oNameSpace.Folders
for each fChild in fParent.Folders
if fChild.DefaultItemType = 9 then
sNames = sNames & fParent.Name & " -- " & fChild.Name & vbCrLf
end If
next
next
MsgBox(sNames)
Am I on the right track?

Answer 1

Tou can use the NavigationModule object to iterate through all the groups of folders. Typically you could use objNavMod.NavigationGroups.GetDefaultNavigationGroup(olPeopleFoldersGroup), but if the user has added groups of calendars manually then this won't get you all the calendars. Also it's possible that permissions prevent accessing the folder programmatically; the code below allows for this.
const olFolderCalendar = 9
const olModuleCalendar = 1
Dim objOL
Dim objNS
Dim objExpCal
Dim objNavMod
Dim objNavGroup
Dim objNavFolder
Dim objFolder
Dim colExpl
dim s
s = ""
set oApp = CreateObject("Outlook.Application")
Set objNS = oApp.Session
Set colExpl = oApp.Explorers
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
For Each objNavGroup In objNavMod.NavigationGroups
For Each objNavFolder In objNavGroup.NavigationFolders
On Error Resume Next
Set objFolder = objNavFolder.Folder
If Err = 0 Then
s = s & objNavGroup.Name & " -- " & left(objFolder.FolderPath,30) & vbcrlf
Else
s = s & objNavGroup.Name & " -- " & objNavFolder.DisplayName & " [no permission]" & vbcrlf
End If
On Error GoTo 0
Next
Next
Set oApp = Nothing
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing
msgbox s
In VBA:
Sub IterateAllCalendars()
Dim s As String
Dim objOL As Outlook.Application
Dim objNS As Outlook.namespace
Dim objExpCal As Outlook.Explorer
Dim objNavMod As Outlook.CalendarModule
Dim objNavGroup As Outlook.NavigationGroup
Dim objNavFolder As Outlook.NavigationFolder
Dim objFolder As Outlook.Folder
Dim colExpl As Outlook.Explorers
s = ""
Set objOL = Application
Set objNS = objOL.Session
Set colExpl = objOL.Explorers
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
For Each objNavGroup In objNavMod.NavigationGroups
For Each objNavFolder In objNavGroup.NavigationFolders
On Error Resume Next
Set objFolder = objNavFolder.Folder
If Err = 0 Then
s = s & objNavGroup.Name & " -- " & Left(objFolder.FolderPath, 30) & vbCrLf
Else
s = s & objNavGroup.Name & " -- " & objNavFolder.DisplayName & " [no permission]" & vbCrLf
End If
On Error GoTo 0
Next
Next
Set objOL = Nothing
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing
MsgBox s
End Sub

Answer 2

#Geoff: Because this was the only slim, structured and working code I found - and I searched quite a while - I add my translation to pure WSH JScript.
var olAppointmentItem = 1;
var olFolderCalendar = 9;
var olFolderNotes = 12;
var olModuleCalendar = 1;
var olMyFoldersGroup = 1;
var oOtlk = new ActiveXObject('Outlook.Application' );
var oMAPI = oOtlk.getNameSpace("MAPI");
var oFldCldr = oMAPI.getDefaultFolder(olFolderCalendar);
var oExpl = oFldCldr.GetExplorer;
var oNavMod = oExpl.NavigationPane.Modules.GetNavigationModule(olModuleCalendar);
var msg = "";
var eGrps = new Enumerator(oNavMod.NavigationGroups);
for (; !eGrps.atEnd(); eGrps.moveNext()) {
var oGrp = eGrps.item();
msg += oGrp.Name + "\n";
var eFlds = new Enumerator(oGrp.NavigationFolders);
for (; !eFlds.atEnd(); eFlds.moveNext()) {
var oFld = eFlds.item();
msg += "\t" + oFld.DisplayName + "\n";
}
}
WScript.echo(msg);