VBA，Outlook，查看“人物日历”

VBA, Outlook, Seeing 'People's Calendars

提问by ForEachLoop

I am tring to programmatically (with VBA) to access calendars others share with me. They are listed in my Outlook under 'People's Calendars.' I have searched the Web for this and all the suggestions have done little more than confuse me. How can I get a listing of all the calendars shared to me, and then one calendar in specific, from among the 'People's Calendars'?

我正在尝试以编程方式（使用 VBA）访问其他人与我共享的日历。它们列在我的 Outlook 中的“人员日历”下。我在网上搜索过这个，所有的建议都让我感到困惑。如何从“人物日历”中获取共享给我的所有日​​历的列表，然后是特定的一个日历？

回答by Alain

Check out the returned values from the following code. It searches for a person by name, same way as when you are typing a recipient into a new email, and then grabs that persons shared calendar and enumerates all shared appointments.

查看以下代码的返回值。它按姓名搜索某人，就像您在新电子邮件中键入收件人一样，然后获取该人的共享日历并枚举所有共享约会。

Dim _namespace As Outlook.NameSpace
Dim _recipient As Outlook.Recipient
Dim calendarFolder As Outlook.Folder

Set _namespace = Application.GetNamespace("MAPI")
Set _recipient = _namespace.CreateRecipient(name)
_recipient.Resolve

If _recipient.Resolved Then
    Set calendarFolder = _namespace.GetSharedDefaultFolder(_recipient, olFolderCalendar)
    'This would display the calendar on the screen:
    'calendarFolder.Display

    Dim oItems As Outlook.Items
    Set oItems = calendarFolder.Items
    'oItems is now a set of all appointments in that person's calendar
    'Play on
End if

回答by ForEachLoop

I think this gets closer. It came from Sue Mosher's outstanding Microsoft Outlook 2007 Programming: Jumpstart for Power Users and Administrators. I hope she doesn't mind.

我认为这越来越近了。它来自 Sue Mosher 出色的 Microsoft Outlook 2007 编程：高级用户和管理员的快速入门。我希望她不会介意。

Sub ShowOtherUserCalFolders()
    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
    Dim objExpl As Outlook.Explorer
    Set objOL = Application
    Set objNS = objOL.Session
    Set colExpl = objOL.Explorers
    Set objExpCal = _
      objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    Set objNavMod = objExpCal.NavigationPane.Modules. _
      GetNavigationModule(olModuleCalendar)
    Set objNavGroup = objNavMod.NavigationGroups. _
      GetDefaultNavigationGroup(olPeopleFoldersGroup)
    For Each objNavFolder In objNavGroup.NavigationFolders
        Set objFolder = objNavFolder.Folder
        Set objExpl = _
          colExpl.Add(objFolder, olFolderDisplayNormal)
        objExpl.Activate
        objExpl.WindowState = olMaximized
        objExpl.WindowState = olMinimized
    Next
    Set objOL = Nothing
    Set objNS = Nothing
    Set objNavMod = Nothing
    Set objNavGroup = Nothing
    Set objNavFolder = Nothing
    Set objFolder = Nothing
    Set colExpl = Nothing
    Set objExpl = Nothing
End Sub

回答by Mike

Just a suggestion to help people who may be trying to use the ShowOtherUserCalFolders() code posted here. This code will create multiple hidden instances of outlook which if run many times can eventual bog down your machine. Instead of creating a new Outlook.application you can call the current open one (outlook must be open for this to work).

只是一个建议，以帮助可能尝试使用此处发布的 ShowOtherUserCalFolders() 代码的人。此代码将创建 Outlook 的多个隐藏实例，如果运行多次，最终可能会使您的机器陷入困境。您可以调用当前打开的应用程序而不是创建新的 Outlook.application（Outlook 必须打开才能工作）。

To do this replace Dim objOL As Outlook.Applicationwith Dim objOL as Objectand Set objOL = Applicationwith Set myOlApp = GetObject(, "Outlook.Application")

要做到这一点替换Dim objOL As Outlook.Application用Dim objOL as Object，并Set objOL = Application用Set myOlApp = GetObject(, "Outlook.Application")

Also make sure you close the objExpCal Explorer as this will also create a hidden instance of outlook, add objExpCal.Closeto the end of your code.

还要确保关闭 objExpCal Explorer，因为这也会创建 Outlook 的隐藏实例，添加objExpCal.Close到代码的末尾。