如何获取当前登录用户的电子邮件地址？

Question

我是VBA新手，正在尝试使一个自动化的Word文档工作。目前该文档中有一个按钮，按下该按钮将会发送一封带有文档附件的电子邮件。

但是，我还需要获取当前发送电子邮件的用户的电子邮件地址，以便在发送之前将其放入文档中。我在互联网上搜索的代码都不能满足我的情况。以下是我的当前代码。

Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)

Set Doc = ActiveDocument
Doc.Save

With EmailItem
    .Subject = "Requesting Authorization Use Overtime"
    .Body = "Please review the following request for overtime" & vbCrLf & _
    "" & vbCrLf & _
    "Thanks"
    .To = "[e-mail]"
    .Importance = olImportanceNormal
    .Attachments.Add Doc.FullName
    .Send
End With

我不确定这是否相关，但在使用文档时，Outlook应用程序将始终打开并由用户登录。我习惯于在这些情况下使用intellisense帮助来尝试方法和属性，但似乎很少有来自智能感应的帮助。

- SikhWarrior

Answer 1

一切取决于“当前用户地址”的定义。

1. 可以从 Appication.Session.CurrentUser (返回 Recipient 对象) 中检索 Outlook 主帐户的地址。使用 Recipient.Address 属性。然而请注意，对于 Exchange 帐户（Recipient.AddressEntry.Type == "EX"），您将收到 EX 类型的地址。要检索 SMTP 地址，请使用 Recipient.AddressEntry.GetExchangeUser().PrimarySmtpAddress。 准备好在出现错误时处理 null/异常。这是您在特定情况下最可能需要的。
   
   在 Extended MAPI 级别（C++ 或 Delphi）中，则使用 IMAPISession::QueryIdentity（您可以在OutlookSpy（我是其作者）中测试它 - 单击 IMAPISession 按钮，然后单击 QueryIdentity）。然后，您可以读取 PR_ADDRTYPE 属性（“EX” vs “SMTP”）和 PR_EMAIL_ADDRESS（当 PR_ADDRTYPE =“SMTP” 时）或（在 Exchange 的情况下）PR_SMTP_ADDRESS（不能保证存在）和 PR_EMS_AB_PROXY_ADDRESSES（多值属性将包含 Exchange 地址，包括所有代理（别名）地址）。

2. 如果在配置文件中有多个帐户，则可以通过多个帐户发送或接收电子邮件。在这种情况下，请使用 MailItem.SendUsingAccount（返回 Account 对象，可以为 null - 在这种情况下请使用 Application.Session.CurentUser）。对于接收、发送或正在撰写的电子邮件（Application.ActiveInspector.CurrentItem 或 Application.ActiveExplorer.ActiveInlineResponse），这都是有效的。

3. 可以使用Namespace.Accounts集合(Application.Session.Accounts)访问给定配置文件中的所有帐户。可以使用Account.SmtpAddress属性访问帐户地址。 请注意，Outlook对象模型仅公开电子邮件帐户。一些存储帐户(例如PST)不在集合中，因为它们没有固有的用户身份，即使其他一些帐户(例如POP3/SMTP)可以传递到该存储区。如果要访问所有帐户，可以使用Redemption(其作者是我)及其RDOSession.Accounts集合(RDOAccounts对象)。 在Extended MAPI级别上，可以通过IOlkAccountManager接口公开帐户。如果单击IOlkAccountManager按钮，可以在OutlookSpy中使用它。

4. 对于委托Exchange存储，存储所有者在Outlook对象模型中不可见。您可以使用Extended MAPI(请注意，在缓存的存储区中只公开PR_MAILBOX_OWNER_ENTRYID属性，而不是在线存储区)。您可以解析Exchange存储区条目id并从中提取EX类型地址。然后，可以根据EX地址构造GAL对象条目id。也可以使用Redemption及其RDOExchangeMailboxStore对象及其Owner属性访问存储所有者。

- Dmitry Streblechenko

Answer 2

通常，电子邮件地址是分配给Outlook邮件文件夹的名称。
因此，请尝试以下操作：

'~~> add these lines to your code
Dim olNS As Outlook.NameSpace
Dim olFol AS Outlook.Folder

Set olNS = OL.GetNamespace("MAPI")
Set olFol = olNS.GetDefaultFolder(olFolderInbox)

MsgBox olFol.Parent.Name '~~> most cases contains the email address

假设您正在使用正确设置了对象引用的 Early Bind ，则可以这样做。
另一种访问此类信息的方法是直接使用命名空间属性。

MsgBox olNS.Accounts.Item(1).DisplayName '~~> usually email address
MsgBox olNS.Accounts.Item(1).SmtpAddress '~~> email address
MsgBox olNS.Accounts.Item(1).UserName '~~> displays the user name

我希望上述任何内容能在某种程度上对您有所帮助。

- L42

---

@SikhWarrior 很高兴它管用。你还可以使用额外的属性 :) - L42

绝对不是。商店名称，特别是在较旧版本的Outlook中，不包含商店所有者或当前用户的电子邮件地址（如果您在配置文件中有多个商店，则可能与当前用户不同）。 - Dmitry Streblechenko

@DmitryStreblechenko 是的，确实不是一个很整洁的解决方案，它只适用于预定义的场景。 - L42

Answer 3

这篇回答是关于“后期绑定”的，所以您不需要引用库。将以下代码放入一个模块中：

    Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object, myitem As Object
    Dim User As String

    Set OL = CreateObject("outlook.application")
    Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries

    User = OL.Session.CurrentUser.Name

    Set oentry = olAllUsers.Item(User)

    Set oExchUser = oentry.GetExchangeUser()

    msgbox oExchUser.PrimarySmtpAddress

- James

---

它的运行非常顺利，但是它也会给出错误的电子邮件地址，例如它正确地给出了用户名为“约翰·多”，但oExchUser却给出了“[e-mail]”，这很奇怪。 - Punith GP

Answer 4

函数式方法

为了使其更具可重用性，尝试从函数中返回电子邮件。

延迟绑定示例

''
' Creates a new instance of Microsoft Outlook to get the current users
' email address.
' Late Binding Demo.
'
' @exception If any errors it will return an optional parameter for fallback values
''
Public Function GetUsersOutlookEmail(Optional ByVal errorFallback As String = "") As String
On Error GoTo catch
    With CreateObject("outlook.application")
        GetUsersOutlookEmail = .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Name
    End With
Exit Function
catch:
    GetUsersOutlookEmail = errorFallback
End Function

早期绑定示例

''
' Creates a new instance of Microsoft Outlook to get the current users
' email address.
' Late Binding Demo.
'
' @reference Microsoft Outlook 16.0 Object Reference
' @exception If any errors it will return an optional parameter for fallback values
''
Public Function GetUsersOutlookEmail(Optional ByVal errorFallback As String = "") As String
On Error GoTo catch
    With New Outlook.Application
        GetUsersOutlookEmail = .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Name
    End With
Exit Function
catch:
    GetUsersOutlookEmail = errorFallback
End Function

错误处理

每当您像这样进行API调用时，总会有出现错误的可能性。我为这些演示选择的方法是提供一个可选参数作为备用电子邮件。这使其具有动态性，因为您可以检查它是否为空，或者您可以提供类似于用户名Environ("Username") & "@outlook.com"的内容。

- Robert Todar