如何提取商店的电子邮件地址?

How can I extract the email address for a store?

在我的公司,我们有许多不同的电子邮件地址,这些地址会转到由少数人管理的“共享收件箱”帐户。

我们想跟踪每个收件箱中有多少封电子邮件。

一个用户可能会管理几个不同的共享收件箱,没有一个用户可以访问同一组收件箱。

我的 VBA 代码循环遍历所有登录用户的共享收件箱,并计算每个收件箱文件夹中的电子邮件数量,这些文件夹不是他们自己的“个人”收件箱,并将该数据记录到table 使用单独的程序:

Sub WorkPosition()

    Dim ThisUser As String
    Dim Mailbox As Object
    Dim MailBoxName As String
    Dim oStore As Outlook.Store
    Dim olFolder As Outlook.Folder

    ThisUser = UCase(Environ("UserName"))

    For x = Application.Session.Stores.Count To 1 Step -1
        Set Mailbox = Nothing
        On Error Resume Next
        Set Mailbox = Application.Session.Stores(x)
        On Error GoTo 0
        If Mailbox Is Nothing Then GoTo SkipMailbox
        MailBoxName = Mailbox
        If InStr(UCase(Mailbox), ThisUser) = 0 Then
            Set olFolder = Mailbox.GetDefaultFolder(olFolderInbox)
            Set objItems = olFolder.Items
            MailCount = objItems.Count
            LogFolder MailBoxName, MailCount, ThisUser 'Run the "Logfolder" sub which logs the data
        End If
    SkipMailbox:
    Next x

End Sub

这一切都有效,除了用户没有很好地命名他们的共享收件箱帐户。多个用户的共享收件箱名称相同,但关联到不同的电子邮件地址。

例如:

当 Charles 和 David 使用我的 VBA 代码记录他们的邮件计数时,他们都使用 MailBoxName 作为“客户问题”进行记录。

我得出的结论是我不想记录邮箱名称。我想改为记录电子邮件地址,他们无法更改并且对于该收件箱来说是唯一的。

如果收件箱中有电子邮件,我可以执行此操作,因为我可以从文件夹中的第一个邮件项目中获取“收件人”地址,但如果文件夹中有 0 封电子邮件,则不能。

如何将与用户的 Outlook 存储关联的传入电子邮件地址提取到 VBA 字符串中,以便我可以将其传递到我的“LogFolder”过程?

Outlook 对象模型不会公开任何类似的内容。

如果使用 Redemption is an option (I am its author), it exposes RDOExchangeMailbox.Owner property (returns RDOAddressEntry 对象):

  skPrimaryExchangeMailbox = 3
  skDelegateExchangeMailbox = 4
  set Session = CreateObject("Redemption.RDOSession")
  Session.MAPIOBJECT = Application.Session.MAPIOBJECT
  for each Store in Session.Stores
    If (Store.StoreKind = skPrimaryExchangeMailbox) or (Store.StoreKind = skDelegateExchangeMailbox)Then
      Debug.Print Store.Name & " : " & Store.Owner.SMTPAddress
    End If
  next