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

时间:2015-04-28 14:54:47

标签: email outlook alias outlook-vba

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

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

我想让它返回别名

 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. 运行宏

3 个答案:

答案 0 :(得分:2)

尝试使用以下方法:

  1. 使用Namespace类的CreateRecipient方法创建一个Recipient对象。
  2. 调用Recipient类的Resolve方法,以针对通讯簿解析收件人对象。
  3. 获取AddressEntry属性值,返回与已解析的收件人对应的AddressEntry对象。
  4. 如果AddressEntry属于Exchange AddressList对象(如全局地址列表(GAL)并且对应于Exchange用户),则调用AddressEntry类的GetExchangeUser方法,它返回表示AddressEntry的ExchangeUser对象。
  5. ExchangeUser类的Alias属性返回表示ExchangeUser别名的String。
  6. 您可能还会发现Getting Started with VBA in Outlook 2010文章有用。

答案 1 :(得分:0)

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

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

答案 2 :(得分:0)

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

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