Active Direcotry probleem (Active Directory & Access & VBA & LDAP)

[RoyGeraets]

Beste Access Whizkids en iedereen die mij verder kan helpen!!!

Voor stage ben ik een database aan het maken die alle gebruikersinformatie uit de Active Directory haalt en deze in Access tabellen stopt. Denk hierbij aan.
* Gebruikers
-Gebruikersnaam
-Inlognaam
-Status
-Afdeling
-E-Mail
* Groups (Volgens AGDLP prencipe)
-Domain Local groepen
-Global Groepen
-Users ( Alleen de gebruikers in de lokale groep)
* Directory's
-Director's (Via DumpSec)
-Groepen
-Rechten

De Gebruikers en Groepen importeer ik via het LDAP (Lightweight Directory Access Protocol). Hiermee kan je zonder Creditails een verbinding maken met de Active Directory en gegevens opvragen.
Het importeren van Gebruikers, Groepen en Directory's is gelukt.

Echter is mijn Probleem

Groepen hebben atributten, hieraan zit informatie over de groep gekoppeld. Zie dit voorbeeld.
Van mijn Globale groep wil ik De naam terug krijgen:
* De naam ("strGroepNaam") Dit lukt
* De Members ("OBJLocalGroupMember.CN) Dit lukt ook
* De MemberOF (dit moet de lokale groep zijn) Dit lukt niet!!!

Hier de Code die de data moet importeren.
De code zoals hieronder weergegeven werkt 100%.

Private Sub Gr_AD_Click()

Dim strGroepNaam As String
Dim iAantal As Integer
Dim OBJGroup As Object
Dim OBJconnection As Object
Dim OBJcommand As Object
Dim OBJrecordset As Object
Dim OBJLocalGroupMember As Object
Dim DB As dao.Database
Dim rs As dao.Recordset

Const ADS_SCOPE_SUBTREE = 2

Set DB = CurrentDb
Set rs = DB.OpenRecordset("GroepenAD", dbOpenDynaset)
Set OBJconnection = CreateObject("ADODB.Connection")
iAantal = 0

OBJconnection.Provider = "ADsDSOObject"
OBJconnection.Open "Active Directory Provider"
Set OBJcommand = CreateObject("ADODB.Command")
Set OBJcommand.ActiveConnection = OBJconnection

DoCmd.SetWarnings False
CurrentDb.Execute "delete * from GroepenAD"
DoCmd.SetWarnings True

OBJcommand.CommandText = _
"SELECT ADsPath, Name FROM 'LDAP://OU=(..), OU=(..), DC=(..), DC=(..), DC=(..)' WHERE objectCategory='(..)' AND name ='(..)*'"
Set OBJrecordset = OBJcommand.Execute

OBJrecordset.MoveFirst
Do Until OBJrecordset.EOF
    
        Set OBJGroup = GetObject(OBJrecordset.Fields("ADsPath").Value)
        
        For Each OBJLocalGroupMember In OBJGroup.members
            iAantal = iAantal + 1
            rs.AddNew
                rs![Gebruiker] = OBJLocalGroupMember.cn
                strGroepNaam = OBJrecordset.Fields("name").Value
                rs![Groep naam] = strGroepNaam
            rs.Update
        Next

    OBJrecordset.MoveNext
  
    Statusbar "Import actie groepen Active Directory bezig!!!"
Loop
Statusbar "Klaar met import actie!!!"

MsgBox (iAantal) & " " & "Groepen geïmporteerd"
End Sub

De oplossing ga ik hier natuurlijk plaatsen. Maar mocht je echt interresse hebben en wil je de hele database zien dan kan dat.
Dit is namelijk maar een klein deel van deze database.

 

[huijb]

Emailadres en telefoonnummer verwijderd ivm privacy