Récupérer la liste des noms et des login des personnes d'une active directory

Signaler
Messages postés
62
Date d'inscription
mardi 18 juillet 2006
Statut
Membre
Dernière intervention
15 avril 2016
-
Messages postés
62
Date d'inscription
mardi 18 juillet 2006
Statut
Membre
Dernière intervention
15 avril 2016
-
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 ?

Merci d'avance

2 réponses

Messages postés
62
Date d'inscription
mardi 18 juillet 2006
Statut
Membre
Dernière intervention
15 avril 2016
10
Pardon, j'ai oublié de préciser que je veux faire ça sous excel 2007
Messages postés
62
Date d'inscription
mardi 18 juillet 2006
Statut
Membre
Dernière intervention
15 avril 2016
10
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 :


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 est é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.