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

Question

我有以下代码尝试从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

Answer 1

看看MSDN上的AddressEntry Object (Outlook)页面，你想要的属性是AddressEntry.Address

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

此外，如果您从工具>引用... *早期绑定Outlook，那么您将获得Intellisense。或者，您可以在Outlook中按[Alt] + [F11]并在那里使用Intellisense。

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

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