Read details from Global Address Book in Outlook into Excel

I use the following code to read information from the Global Address Book in Outlook, and it works. Do any of you know how I can read the Email-address and alias-Name as well? By other word more information from each record. The code below will give me the name only.

Sub GetOutlookAddress()
    Dim outApp As Object, outNS As Outlook.Namespace
    Dim myAddressList As Outlook.AddressList
     
    Set outApp = CreateObject("Outlook.Application")
    Set outNS = outApp.GetNamespace("MAPI")
    Set myAddressList = outNS.Session.AddressLists("Global Address List")
     
    For Each AddressEntries In myAddressList.AddressEntries
        i = i + 1
        Debug.Print myAddressList.AddressEntries(i)
    Next AddressEntries
     
    Set outApp = Nothing
     
End Sub

Depends exactly what you want. I assume from your mention of alias that you are talking about an Exchange server? If so, something like this:

Sub GetOutlookAddress()
    Dim outApp As Object, outNS As Outlook.Namespace
    Dim myAddressList As Outlook.AddressList
     
    Set outApp = CreateObject("Outlook.Application")
    Set outNS = outApp.GetNamespace("MAPI")
    Set myAddressList = outNS.Session.AddressLists("Global Address List")
     
    For Each AddressEntries In myAddressList.AddressEntries
        i = i + 1
        With myAddressList.AddressEntries(i).GetExchangeUser
            debug.print .Name
            debug.print .Alias
            debug.print .PrimarySmtpAddress
        End With
    Next AddressEntries
     
    Set outApp = Nothing
     
End Sub

Sorry - I misread your office version. The ExchangeUser object was added in 2007.

I don't know how to get that sort of data from Outlook (it's not my area), but I would probably bypass it anyway and use ADO with an LDAP query (since I think you are looking at ActiveDirectory properties as much as anything) - something along the lines of :

Sub GetGALData()
   On Error Resume Next
   Dim objConnection, objCommand, objRecordset, objRoot, strDomain
   Const ADS_SCOPE_SUBTREE = 2
   Set objRoot = GetObject("LDAP://rootDSE")
   'Work in the default domain
   strDomain = objRoot.Get("defaultNamingContext")
   
   Set objConnection = CreateObject("ADODB.Connection")
   Set objCommand = CreateObject("ADODB.Command")
   objConnection.Provider = "ADsDSOObject"
   objConnection.Open "Active Directory Provider"
   Set objCommand.ActiveConnection = objConnection
   
   objCommand.Properties("Page Size") = 1000
   objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
   
   objCommand.CommandText = _
      "SELECT DisplayName, mail, SAMAccountName FROM 'LDAP://" & strDomain & _
          "' WHERE objectClass='Person' ORDER BY SAMAccountName"
   Set objRecordset = objCommand.Execute
   
   objRecordset.MoveFirst
   If Not objRecordset.EOF Then ActiveSheet.Cells(2, 1).CopyFromRecordset objRecordset
   objRecordset.Close
   objConnection.Close
End Sub