Extracting Global Adress List Data from an Exchange Account

After searching and browsing various tools, including ContactGenie Quickport which I did not manage to prevent from crashing, I stumbled upon a nice solution how to extract the GAL via
https://www.xing.com/net/vbatreff/vba-tipps-655000/global-address-list-gal-auslesen-39374842

This allowed me to extract all global address lists from the server without having administrational access to the server. All this worked fine with an offline GAL on Office 2010.

Here's the code based on the above source. Just copy to a new VBA :

' benötigte Konstanten
Private Const olExchangeGlobalAddressList As Integer = 0
Private Const olExchangeUserAddressEntry As Integer = 0
Private Const olExchangeRemoteUserAddressEntry As Integer = 5

Public Sub readGAL()
Dim oOutlook As Object
Dim oAddressList As Object
Dim oAddressEntry As Object
Dim oExchangeUser As Object
Dim i As Integer
i = 0

' Outlook-Instanz anlegen
Set oOutlook = CreateObject("Outlook.Application")

' Alle Adress-Listen durchgehen
For Each oAddressList In oOutlook.Session.AddressLists
    ' Prüfen, ob Exchange-Liste
    If oAddressList.AddressListType = olExchangeGlobalAddressList Then
        ' Alle Adress-Einträge durchgehen
        For Each oAddressEntry In oAddressList.AddressEntries
            ' Prüfen, ob Adress-Eintrag
            If oAddressEntry.AddressEntryUserType = 1 Then
                i = i + 1
                Cells(i, 1) = oAddressEntry.Name
                For Each omyUser In oAddressEntry.Members
                    i = i + 1
                    Cells(i, 2) = omyUser.Name
                    Cells(i, 3) = omyUser.Address
                Next
            End If
        Next
    End If
Next

' Objektvariable freigeben
Set oExchangeUser = Nothing
Set oAddressEntry = Nothing
Set oAddressList = Nothing
Set oOutlook = Nothing
End Sub