获取所选约会文件夹的电子邮件地址

Question

我有两个日历，一个是我的，另一个是shared。两者都在Outlook中打开，如下所示。

我如何获得选定约会日历的电子邮件地址？

[我看到AppointmentItem有GetOrganizer来查找创建约会的人，但是我在约会所用的女巫中找不到有关日历用户的任何方法或属性...

因此，我尝试Application.ActiveExplorer.CurrentFolder来获取所选文件夹，然后再获取AdressEntry，但由于文件夹是共享日历，所以我无法获取该文件夹的存储（然后folder.store返回null）。

按照德米特里的建议there，我做到了：

Dim appointment_item As Outlook.AppointmentItem
Dim PR_MAILBOX_OWNER_ENTRYID as String
Dim mapiFolder As Outlook.MAPIFolder
Dim folderStore As Outlook.Store
Dim mailOwnerEntryId As String
Dim entryAddress As Outlook.AddressEntry
Dim smtpAdress As String

PR_MAILBOX_OWNER_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x661B0102"
appointment_item = Application.ActiveExplorer.Selection.Item(1)
mapiFolder = appointment_item.Parent
folderStore = mapiFolder.Store
mailOwnerEntryId = folderStore.PropertyAccessor.GetProperty(PR_MAILBOX_OWNER_ENTRYID)
entryAddress = Application.Session.GetAddressEntryFromID(mailOwnerEntryId)
smtpAdress = entryAddress.GetExchangeUser.PrimarySmtpAddress

MsgBox(smtpAdress)

问题是我无法获得MS文档中写为.Store的共享文件夹的here。

此属性返回一个存储对象除非文件夹是共享文件夹，否则除外（由NameSpace.GetSharedDefaultFolder返回）。在这种情况下，一个用户已将对默认文件夹的访问权委派给了另一用户。对Folder.Store的调用将返回Null。

Answer 1

也许可以在没有内置快捷方式的情况下长时间到达共享日历的文件夹树的顶部。

在我自己的日历上测试，而不是共享日历。

Option Explicit


Sub appointment_sourceFolder()

' VBA code

Dim obj_item As Object
Dim appointment_item As AppointmentItem

Dim parentOfAppointment As Variant
Dim parentParentFolder As Folder
Dim sourceFolder As Folder

Set obj_item = ActiveExplorer.Selection.Item(1)

If obj_item.Class <> olAppointment Then Exit Sub

Set appointment_item = obj_item

' Recurring appointment leads to
'  the parent of the recurring appointment item then the calendar folder.
' Single appointment leads to
'  the calendar folder then the mailbox name.
Set parentOfAppointment = appointment_item.Parent
Set parentParentFolder = parentOfAppointment.Parent
Debug.Print vbCr & " parentParentFolder: " & parentParentFolder.Name

Set sourceFolder = parentParentFolder

' Error bypass for a specific purpose
On Error Resume Next

' If parentParentFolder is the shared calendar,
'   walking up one folder is the mailbox.
' If parentParentFolder is the mailbox,
'  walking up one folder is an error that is bypassed,
'  so no change in sourceFolder.

' Assumption:
'  The shared calendar is directly under the inbox
'   otherwise add more Set sourceFolder = sourceFolder.Parent
Set sourceFolder = sourceFolder.Parent

' Return to normal error handling immediately
On Error GoTo 0

Debug.Print " sourceFolder should be smtp address: " & sourceFolder
'MsgBox " sourceFolder should be smtp address: " & sourceFolder

End Sub