title: Get email address from Outlook GAL?
body: <p>I have the following code to try and grab the GAL from Outlook and drop the person's name + their email address into another sheet. </p>
  
  <p>It gets the first name (but not email address) then stops. If I comment out <code>Sheets("Emails").Cells(intCounter, 2) = objAddressEntry.PrimarySmtpAddress</code>, it lists all the names succesfully, which suggests I might be using the wrong type to get the email address. VBA has no intellisense though so I'm not sure what to use instead!</p>
  
  <pre><code>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 &lt;&gt; "" Then
          intCounter = intCounter + 1
          Application.StatusBar = "Processing no. " &amp; intCounter &amp; " ... " &amp; 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
  </code></pre>