[英]Send an email from Excel 2007 VBA using an Outlook Template & Set Variables
[英]Excel 2007: Format of email address from Outlook 2007
我在 Excel 中有一个名字和姓氏列表,我想利用该列表使用 Visual Basic 在 Outlook 中查找电子邮件地址。
我正在使用以下 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
预先感谢您的帮助。
我假设这些是域用户。 您想从 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
哎哟! 为什么要遍历可能包含数十万个条目的地址列表中的所有项目? 使用 Aplication.Session.CreateRecipient,然后调用 Recipient.Resolve。 如果成功,您可以从 Recipient.AddressEntry 检索 AddressEntry 对象。
如果您需要确保仅针对 GAL 解析名称(顺便说一句,您不应该对 GAL 名称进行硬编码,它会根据区域设置而有所不同),您可以使用Redemption及其 AddreessList.ResolveName 方法 - 所有您需要做的是调用RDOSession.AddressBook.GAL.ResolveName
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.