列出所有活动日历的日历名称

Question

我正在尝试列出Outlook中的所有日历名称（我自己的和共享的日历）。

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) 

我走对了吗？

Answer 1

Tou可以使用NavigationModule对象来遍历所有文件夹组。通常情况下，您可以使用objNavMod.NavigationGroups.GetDefaultNavigationGroup(olPeopleFoldersGroup)，但如果用户手动添加了日历组，则不会获得所有日历。此外，权限可能会阻止以编程方式访问文件夹；下面的代码允许这样做。

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

在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：因为这是我找到的唯一一个纤薄、结构化且可工作的代码，而且我搜索了很长时间，所以我将翻译添加到纯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);