[XL-2007] Récupérer groupe AD d'un utilisateur

Trouvé !!

Voici le code que j'associe au code précédent afin de récupérer l'ensemble des groupes d'un utilisateur ... (Pensez à remplacer NomDomaineEntreprise et ExtensionNomDomaineEntreprise) :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Function RecupGroupeUser(UserName As String) As String
    Dim adoConnection As ADODB.Connection
    Dim adoCommand As ADODB.Command
    Dim adoRecordset As ADODB.Recordset
    Dim strBase, strFilter, strAttributes, strQuery As String
    Dim listGroups() As Variant
    Dim i As Integer
 
    'Initialisation des objets ADO
    Set adoCommand = New ADODB.Command
    Set adoConnection = New ADODB.Connection
    Set adoRecordset = New ADODB.Recordset
 
    adoConnection.Provider = "ADsDSOObject"
    adoConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = adoConnection
 
    'Recherche du domaine Active Directory
    strBase = "<LDAP://dc=NomDomaineEntreprise ;dc=ExtensionNomDomaineEntreprise>"
 
    'Filtre sur l'utilisateur
    strFilter = "(&(objectCategory=user)(samAccountName=" & UserName & "))"
 
    'On récupère l'ensemble des groupes de l'utilisateur
    strAttributes = "memberOf"
 
    'Construction de la requête LDAP
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    adoCommand.Properties("Page Size") = 300
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False
 
    'Exécution de la requête
    Set adoRecordset = adoCommand.Execute
 
    'Parcours des résultats de la requête
    Do Until adoRecordset.EOF
 
        'On stocke l'ensemble des groupes dans un tableau de variants
        listGroups = adoRecordset.Fields("memberOf").Value
 
        'Pour chaque élément du tableau
        For i = 0 To UBound(listGroups)
            Dim chaine_groupe As Variant
            Dim groupTmp As String
 
            chaine_groupe = listGroups(i)
            'On extrait la donnée qui nous intéresse (le nom exact du groupe)
            groupTmp = Mid(chaine_groupe, InStr(chaine_groupe, "CN=") + 3, InStr(chaine_groupe, ",OU=") - 4)
            MsgBox groupTmp
            If groupTmp = "LABO" Then
                RecupGroupeUser = "LABO"
            Else
                If groupTmp = "Unite" Then
                    RecupGroupeUser = "Unite"
                End If
            End If
 
        Next
 
        ' Move to the next record in the recordset.
        adoRecordset.MoveNext
    Loop
 
    ' Clean up.
    adoRecordset.Close
    adoConnection.Close
End Function