Discussion :

[pio_killer]

Bonjour,

je voudrais récupérer la liste des personne de l'entreprise où je travaille.

Dans cette liste, il me faudrait le nom, prénom et login windows.

J'arrive à récupérer la liste des personne mais je bloque pour les logon.

Est-ce que quelqu'un à déjà fait ce genre de manip ?

tout ça sur excel 2007

Merci d'avance

[pio_killer]

C'est bon.
J'ai trouvé un code sur une autre site que j'ai modifié pour mes besoins

Voici le code à mettre dans un module Excel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
Type Type_AD_Extraction
    User_Name As String
    User_Login As String
End Type
Sub Extract_AD_UserName_And_UserLogin()
    Dim Tab_Query() As Type_AD_Extraction
    Dim Pos_Tab_Query As Integer
        '**********************************************************
        'Cette procédure extrait les propriétés
            'Nom prénom et login windows
            'de tous les utilisateur de l'Active Directory
        '**********************************************************
 
        'On définit les variables
        SearchField = "samAccountName"
        SearchString = "*"
        ReturnField = "CN"
        LDAP_objectCategory = "person"
 
        ' Get the domain string ("dc=domain, dc=local")
        Dim strDomain As String
        strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
 
        ' ADODB Connection to AD
        Dim objConnection As ADODB.Connection
        Set objConnection = CreateObject("ADODB.Connection")
        objConnection.Open "Provider=ADsDSOObject;"
 
        ' Connection
        Dim objCommand As ADODB.Command
        Set objCommand = CreateObject("ADODB.Command")
        objCommand.ActiveConnection = objConnection
 
        ' Search the AD recursively, starting at root of the domain
        objCommand.CommandText = _
            "<LDAP://" & strDomain & ">;(&(objectCategory=" & LDAP_objectCategory & ")" & _
            "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"
        ' RecordSet
        Dim objRecordSet As ADODB.Recordset
        Set objRecordSet = objCommand.Execute
 
        Pos_Tab_Query = 0
        ReDim Tab_Query(Pos_Tab_Query)
        If objRecordSet.RecordCount = 0 Then
            Tab_Query(Pos_Tab_Query).User_Name = "not found"  ' no records returned
        Else
            'On balaye la liste
            Do Until objRecordSet.EOF
                If Tab_Query(Pos_Tab_Query).User_Name <> "" Then
                    Pos_Tab_Query = Pos_Tab_Query + 1
                    ReDim Preserve Tab_Query(Pos_Tab_Query)
                End If
 
                'On prend le nom
                Tab_Query(Pos_Tab_Query).User_Name = objRecordSet.Fields(ReturnField)
 
                'On cherche le login
                Tab_Query(Pos_Tab_Query).User_Login = GetAdsProp("cn", Tab_Query(Pos_Tab_Query).User_Name, "samAccountName", "user")
 
                objRecordSet.MoveNext
            Loop
        End If
 
        ' Close connection
        objConnection.Close
 
        ' Cleanup
        Set objRecordSet = Nothing
        Set objCommand = Nothing
        Set objConnection = Nothing
 
        '*********************  Export dans EXCEL  ********************
        'On bloque l'affichage
        Application.ScreenUpdating = False
 
        'On crée une nouvelle feuille
        ActiveWorkbook.Sheets.Add
 
        'On écrit le résultat
        ligne = 1
        Cells(ligne, 1) = "NOM"
        Cells(ligne, 2) = "LOGIN"
        ligne = ligne + 1
        For Pos_Tab_Query = 0 To UBound(Tab_Query)
            Cells(ligne, 1) = Tab_Query(Pos_Tab_Query).User_Name
            Cells(ligne, 2) = Tab_Query(Pos_Tab_Query).User_Login
            ligne = ligne + 1
        Next Pos_Tab_Query
 
        'On met en page
        Cells.Select
        Selection.ColumnWidth = 100
        Selection.RowHeight = 100
        Cells.EntireRow.AutoFit
        Cells.EntireColumn.AutoFit
        Cells(1, 1).Select
        '**************************************************************
End Sub
Function GetAdsProp(ByVal SearchField As String, _
    ByVal SearchString As String, _
    ByVal ReturnField As String, _
    ByVal Val_objectCategory As String) As String
        '************************************************************************************
        'Cette fonction fait une requête par rapport au champ renseignés
 
        'Elle peut être lancée individuellement
        'Exemples :
            'Pour connaitre le login d'une personne
                'Var_User_Name = "DUPOND Pierre"
                'Var_Login = GetAdsProp("cn", Var_User_Name, "samAccountName", "user")
            'Pour connaitre le nom et le prénom d'une personne si on a le LOGIN
                'Var_Login = "toto" 'il s'agit du login de connexion Windows
                'Var_User_Name = GetAdsProp("samAccountName", Var_Login, "CN", "person")
        '************************************************************************************
 
        ' Get the domain string ("dc=domain, dc=local")
        Dim strDomain As String
        strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
 
        ' ADODB Connection to AD
        Dim objConnection As ADODB.Connection
        Set objConnection = CreateObject("ADODB.Connection")
        objConnection.Open "Provider=ADsDSOObject;"
 
        ' Connection
        Dim objCommand As ADODB.Command
        Set objCommand = CreateObject("ADODB.Command")
        objCommand.ActiveConnection = objConnection
 
        ' Search the AD recursively, starting at root of the domain
        objCommand.CommandText = _
            "<LDAP://" & strDomain & ">;(&(objectCategory=" & Val_objectCategory & ")" & _
            "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"
        ' RecordSet
        Dim objRecordSet As ADODB.Recordset
        Set objRecordSet = objCommand.Execute
 
 
        If objRecordSet.RecordCount = 0 Then
            GetAdsProp = "not found"  ' no records returned
        Else
            GetAdsProp = objRecordSet.Fields(ReturnField)  ' return value
        End If
 
        ' Close connection
        objConnection.Close
 
        ' Cleanup
        Set objRecordSet = Nothing
        Set objCommand = Nothing
        Set objConnection = Nothing
End Function

Il suffit de lancer la procédure "Extract_AD_UserName_And_UserLogin" et le résultat sera écrit dans une feuille Excel.

La partie d'extraction du résultat dans une feuille peut être adapter au besoin car le résultat est inscrit dans la variable tableau "Tab_Query"

Voilà.
Si ça peut servir à d'autre.