Hi,

I found following code by Scott C Lyerly to extract Global Address Book data to a worksheet.

Global address book got different companies, can select only a particular company email to be extracted instead of all data.

Example : I want all data of a company "??????@mycompany1.com"


Public Sub GetOutlookExchangeUserInformation()
'   This goes into the Global Address List for the MS Exchange Server
'   and returns a selection of data to a worksheet.
'   To get a view off all the potential data poitns that Outlook contains,
'   see the following URL:
'   https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook.exchangeuser_properties.aspx
 
    ' Variable declarations.
    Dim olApp           As Outlook.Application
    Dim olNameSpace     As Namespace
    Dim olAddrList      As AddressList
    Dim olAddrEntry     As AddressEntry
    Dim olExchgnUser    As ExchangeUser
    Dim sh              As Worksheet
    Dim lCnt            As Long
 
    ' Set the Outlook object variables
    Set olApp = CreateObject("Outlook.Application")
    Set olNameSpace = olApp.GetNamespace("MAPI")
    Set olAddrList = olNameSpace.AddressLists("Global Address List")
 
    ' Create a new worksheet.
    Set sh = ThisWorkbook.Worksheets.Add
 
    ' Add some headers for our data.
    With sh
        .Cells(1, 1) = "NAME"
        .Cells(1, 2) = "FIRST NAME"
        .Cells(1, 3) = "LAST NAME"
        .Cells(1, 4) = "ALIAS"
        .Cells(1, 5) = "JOB TITLE"
        .Cells(1, 6) = "DEPARTMENT"
    End With
 
    ' Start the counter in the second row.
    lCnt = 2
 
    ' Iterate through the address entires in the address list.
    For Each olAddrEntry In olAddrList.AddressEntries
 
        ' For each entry, set the an exchange user object.
        ' I'm using t exchange user object because I find that
        ' most companies using Outlook are set up on MS Exchange Server.
        ' You can also use the GetContact whcih will return the
        ' the same information from the Outlook Contact Address Book
        ' (as opposed to the Global Address List).
        Set olExchgnUser = olAddrEntry.GetExchangeUser
 
        ' Turn off error handling, because occasionally you hit a
        ' record with nothing in it and it throws an error.
        On Error Resume Next
 
        ' Write the Outlook data to the worksheet.
        With olExchgnUser
            sh.Cells(lCnt, 1) = .Name
            sh.Cells(lCnt, 2) = .FirstName
            sh.Cells(lCnt, 3) = .LastName
            sh.Cells(lCnt, 4) = .Alias
            sh.Cells(lCnt, 5) = .JobTitle
            sh.Cells(lCnt, 6) = .Department
        End With