Option Compare Database
Option Explicit
Const groupType =  268435456 
Const userType =  805306368 
Const companyName = "Interterminal"
Private GABName As String
Private DC As String

Public Property Let name(s As String)
    GABName = s
End Property

Public Property Get name() As String
    name = GABName
End Property

Public Property Let domainController(s As String)
    DC = s
End Property

Public Property Get domainController() As String
    domainController = DC
End Property


Private Function configurationNamingContext() As String
Dim root
    Set root = GetObject("LDAP://" & DC & "/RootDSE")
    configurationNamingContext = root.Get("configurationNamingContext")
    Set root = Nothing
End Function

Private Function defaultNamingContext() As String
Dim root
    Set root = GetObject("LDAP://" & DC & "/RootDSE")
    defaultNamingContext = root.Get("defaultNamingContext")
    Set root = Nothing
End Function

Public Function getGroupList() As ADODB.Recordset
Dim con As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSearchRoot As String
Dim GALName As String
    strSearchRoot = "LDAP://" & DC & "/" & defaultNamingContext
    con.provider = "ADsDSOObject"
    con.Open
    Set rst.activeConnection = con
    GALName = "'CN=" & name & ",CN=All Global Address Lists,CN=Address Lists Container,CN=" & companyName & ",CN=Microsoft Exchange,CN=Services," & configurationNamingContext & "'"
    rst.Open "SELECT  displayName,mail,name From '" & strSearchRoot & "'  WHERE sAMAccountType=" & groupType & " and msExchHideFromAddressLists <> true and showInAddressBook=" & GALName & ""
    Set getGroupList = rst
End Function

Private Sub Class_Initialize()
    GABName = "Default Global Address List"
End Sub