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

Question

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

我到目前为止的代码如下。然而，这个代码给出/ 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. 运行宏

Answer 1

有了你们的帮助，我能够通过捕捉收件人地址输入到解决这个问题，将其添加为新的项目，显示别名，然后删除收件人：

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 

Answer 2

尝试使用以下方法：

1. 使用的命名空间类的CreateRecipient方法来创建一个收件人对象。
2. 调用Recipient类的Resolve方法根据地址簿解析收件人对象。
3. 获取AddressEntry属性值，返回与解析的收件人对应的AddressEntry对象。
4. 调用AddressEntry类的GetExchangeUser方法，它将返回一个ExchangeUser对象，该对象表示AddressEntry属于诸如全局地址列表（GAL）之类的Exchange地址列表对象并对应于Exchange用户。
5. ExchangeUser类的Alias属性返回一个表示ExchangeUser别名的字符串。

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