Outlook 2010 VBA 显示收件人别名的代码

Outlook 2010 VBA code to show alias of recipient

我的公司为每位员工分配了一个 ID,该 ID 作为 'alias' 存储在 Outlook 中。我们经常使用这个 ID,我正在寻找一种简单的方法来查看它。
现在,我在一封新电子邮件中输入收件人姓名,双击该姓名,单击更多选项,然后单击 Outlook 属性。我正在寻找一个宏,我可以在新电子邮件中输入收件人姓名,然后 运行 该宏只会弹出收件人的别名作为消息框(最好将其复制到剪贴板)。我已经尝试(但失败了)自己写这个。

我目前的代码如下。但是,这段代码给出了 /o=corpexchange/ou=exchange 管理组.....

我正在尝试将其设置为 return 别名

 Sub ReadRecpDetail2()



Dim myOlApp As Outlook.Application

Dim myItem As Outlook.MailItem

Dim myRecipient As Outlook.recipient

 Dim recipient As Outlook.recipient


Set myOlApp = GetObject(, "Outlook.Application")

Set myItem = myOlApp.ActiveInspector.CurrentItem


For Each recipient In myItem.Recipients
  recipient.Resolve
  MsgBox recipient.AddressEntry

Next recipient
    End Sub

重新创建:

  1. 打开新的 outlook 电子邮件
  2. 输入电子邮件地址并解析
  3. 运行宏

尝试使用以下方法:

  1. 使用命名空间的 CreateRecipient 方法 class 创建收件人对象。
  2. 调用收件人的 Resolve 方法 class 以根据地址簿解析收件人对象。
  3. 获取AddressEntry属性值,returns解析收件人对应的AddressEntry对象
  4. 调用 AddressEntry class 的 GetExchangeUser 方法,它 returns 如果 AddressEntry 属于 Exchange AddressList 对象(例如全局地址列表),则它是一个表示 AddressEntry 的 ExchangeUser 对象(GAL) 并对应于 Exchange 用户。
  5. ExchangeUser 的 Alias 属性 class returns 表示 ExchangeUser 别名的字符串。

您可能还会发现 Getting Started with VBA in Outlook 2010 文章有帮助。

在你的帮助下,我通过捕获收件人地址条目、将其添加为新项目、显示别名,然后删除收件人来解决此问题:

Sub ReadRecpDetail()
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.mailItem
Dim myRecipient As Outlook.recipient
Dim recipient As Outlook.recipient
Dim SMTPaddress As String
Dim entry As Outlook.AddressEntry
Dim entrystring As String
Dim Copytoclipboard As New DataObject

Set myOlApp = GetObject(, "Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set recipient = myItem.Recipients.Item(1)
Set myRecipient = myItem.Recipients.Add(recipient.AddressEntry)

myRecipient.Resolve
entrystring = myRecipient.AddressEntry.GetExchangeUser.Alias
MsgBox (entrystring)
Copytoclipboard.SetText entrystring
Copytoclipboard.PutInClipboard
myRecipient.Delete

End Sub

我遇到过类似的情况,我需要在电子邮件中打印出所有收件人的用户名,以便将它们导出到另一个应用程序。我的解决方案基于您在下面的回答,以防对其他人有所帮助。

Sub PrintRecipientAliases()

    Dim myOlApp As Outlook.Application
    Dim myItem As Outlook.MailItem
    Dim recipient As Outlook.recipient

    Set myOlApp = GetObject(, "Outlook.Application")
    Set myItem = myOlApp.ActiveInspector.CurrentItem

    For Each recipient In myItem.Recipients
        With recipient
            Debug.Print recipient.AddressEntry.GetExchangeUser.Alias
        End With
    Next

End Sub