我在Excel中有一个名字和姓氏的列表,我想利用该列表在Outlook中使用visual basic查找电子邮件地址。
我正在使用以下VB代码:
Private Sub GetAddresses()
Dim o, AddressList, AddressEntry
Dim c As Range, r As Range, AddressName As String
Set o = CreateObject("Outlook.Application")
Set AddressList = o.Session.AddressLists("Global Address List")
Set r = Range("a1:a3")
For Each c In r
AddressName = Trim(c.Value) & ", " & Trim(c.Offset(0, 1).Value)
For Each AddressEntry In AddressList.AddressEntries
If AddressEntry.Name = AddressName Then
c.Offset(0, 2).Value = AddressEntry.Address
Exit For
End If
Next AddressEntry
Next c
End Sub
代码似乎工作正常,直到实际检索电子邮件地址为止。在匹配名称后,返回以下内容而不是地址。有没有人知道我做错了什么。
/O=Compnay/OU=Company/cn=Recipients/cn=shs
先谢谢你的帮助。
答案 0 :(得分:6)
我假设这些是域用户。您想从exchangeUser对象获取SMTP地址。我已更新您的代码以显示此内容。
Private Sub GetAddresses()
Dim o, AddressList, AddressEntry
Dim c As Range, r As Range, AddressName As String
'added variable for exchange user object
Dim exchangeUser As Outlook.exchangeUser
Set o = CreateObject("Outlook.Application")
Set AddressList = o.Session.AddressLists("Global Address List")
Set r = Range("a1:a3")
For Each c In r
AddressName = Trim(c.Value) ' & ", " & Trim(c.Offset(0, 1).Value)
For Each AddressEntry In AddressList.AddressEntries
If AddressEntry.Name = AddressName Then
'set the exchange user object
Set exchangeUser = AddressEntry.GetExchangeUser
'get the smtp addresss
c.Offset(0, 2).Value = exchangeUser.PrimarySmtpAddress
'release
Set exchangeUser = Nothing
Exit For
End If
Next AddressEntry
Next c
End Sub
答案 1 :(得分:0)
哎哟!为什么要循环遍历地址列表中可能包含数十个条目数量的所有项目?使用Aplication.Sesssion.CreateRecipient,然后调用Recipient.Resolve。如果成功,您可以从Recipient.AddressEntry中检索AddressEntry对象 如果您需要确保仅针对GAL解析名称(顺便说一句,您不应该硬编码GAL名称,它将根据区域设置而有所不同),您可以使用Redemption及其AddreessList.ResolveName方法 - 所有你需要做的就是致电RDOSession.AddressBook.GAL.ResolveName