如何从Outlook GAL获取电子邮件地址?

时间:2018-02-28 11:31:15

标签: vba excel-vba outlook-vba excel

我有以下代码尝试从Outlook中获取GAL并将此人的姓名+他们的电子邮件地址放到另一张表中。

获取名字(但不是电子邮件地址)然后停止。如果我注释掉Sheets("Emails").Cells(intCounter, 2) = objAddressEntry.PrimarySmtpAddress,它会成功列出所有名称,这表明我可能使用了错误的类型来获取电子邮件地址。虽然VBA没有intellisense,所以我不确定要使用什么!

Private Sub UpdateEmails()

' Need to add reference to Outlook
' Adds addresses to existing Sheet called Emails and
' defines name NamesAndEmailAddresses containing this list

On Error GoTo error

Dim objOutlook As Outlook.Application
Dim objAddressList As Outlook.AddressList
Dim objAddressEntry As Outlook.AddressEntry
Dim intCounter As Integer

Application.ScreenUpdating = False

' Setup connection to Outlook application
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = objOutlook.Session.AddressLists("Global Address List")

Application.EnableEvents = False

' Clear existing list
Sheets("Emails").Range("A:A").Clear

'Step through each contact and list each that has an email address
For Each objAddressEntry In objAddressList.AddressEntries
    If objAddressEntry.Address <> "" Then
        intCounter = intCounter + 1
        Application.StatusBar = "Processing no. " & intCounter & " ... " & objAddressEntry.Address
        Sheets("Emails").Cells(intCounter, 1) = objAddressEntry.Name
        Sheets("Emails").Cells(intCounter, 2) = objAddressEntry.PrimarySmtpAddress
        DoEvents
    End If
Next objAddressEntry

' Define range called "NamesAndEmailAddresses" to the list of emails
Sheets("Emails").Cells(1, 2).Resize(intCounter, 1).Name = "NamesAndEmailAddresses"
error:
Set objOutlook = Nothing
Application.StatusBar = False

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:0)

查看MSDN上的AddressEntry Object (Outlook)页面,您想要的属性为AddressEntry.Address

Sheets("Emails").Cells(intCounter, 2) = objAddressEntry.Address

此外,如果您从工具&gt;提前绑定Outlook 引用... * 然后您将获得智能感知。或者,您可以在Outlook中按[Alt] + [F11]并在那里使用Intellisense。

{EDIT} 由于这是在Exchange Server上提供路径而不是完整的电子邮件地址 如果联系人位于Exchange地址列表中,则可以使用.GetExchangeUser.PrimarySmtpAddress在Exchange Server上获取用户的主Smtp地址。 (对于您帐户中的本地联系人,请改用GetContact.Email1Address

Sheets("Emails").Cells(intCounter, 2) = objAddressEntry.GetExchangeuser.PrimarySmtpAddress