Question

我正在尝试吐出所有在我的展望中流行的日历名称（我自己的，以及我的共享名称）。
但我对VB脚本或outlook.application都没有经验。

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

显示所有活动Outlook日历中的日历名称，VB脚本

1 个答案: