我如何登录到一个交换日历从excel

Question

我正在编写一个excel宏，它使用用户凭证连接到许多outlook(exchange)日历，并解析日历数据以将其输出到电子表格。我可以从本地outlook应用程序获取日历数据，但不知道如何登录到另一个账户。这可能吗?一定有办法访问交换日历。从我已经在互联网上收集到的东西来看，我可能会使用MAPI?我只是不知道如何处理这种情况。

Sub ListAppointments()
'Dim mapi_session As MSMAPI.MAPISession
'Set mapi_session = CreateObject("MSMAPI.MAPISession")
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim myStart As Date
Dim myEnd As Date
Dim NextRow As Long
Dim today, date1, date2
today = VBA.Format(Date, "yyyy-mm-dd")
myStart = VBA.Format(Year(today) & "-" & Month(today) & "-01", "yyyy-mm-dd")
myEnd = DateAdd("m", 3, myStart)
date1 = InputBox("Enter range beginning date", , myStart)
date2 = InputBox("Enter range end date", , myEnd)
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
olNS.Logon "", "", False, True
Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
Range("A1:D1").Value = Array("Subject", "Start", "End", "Location")
NextRow = 2
For Each olApt In olFolder.Items
    If olApt.Start >= myStart And olApt.End <= myEnd Then
        Cells(NextRow, "A").Value = olApt.Subject
        Cells(NextRow, "B").Value = olApt.Start
        Cells(NextRow, "C").Value = olApt.End
        Cells(NextRow, "D").Value = olApt.Location
        NextRow = NextRow + 1
    End If
Next olApt
Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Columns.AutoFit
End Sub

这是到目前为止我所得到的，它只是让我获取本地outlook数据。

Answer 1

使用olNS.CreateRecipient/olNS.GetSharedDefaultFolder(..., olFolderCalendar)打开另一个Exchange邮箱的Calendar文件夹。