Sujet Précédent Sujet Suivant

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

pio_killer Messages postés 62 Date d'inscription mardi 18 juillet 2006 Statut Membre Dernière intervention 15 avril 2016 - 24 mai 2012 à 12:29
pio_killer Messages postés 62 Date d'inscription mardi 18 juillet 2006 Statut Membre Dernière intervention 15 avril 2016 - 24 mai 2012 à 15:17
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

Réponse 1 / 2
pio_killer Messages postés 62 Date d'inscription mardi 18 juillet 2006 Statut Membre Dernière intervention 15 avril 2016 13
24 mai 2012 à 12:32
Pardon, j'ai oublié de préciser que je veux faire ça sous excel 2007
0
Réponse 2 / 2
pio_killer Messages postés 62 Date d'inscription mardi 18 juillet 2006 Statut Membre Dernière intervention 15 avril 2016 13
24 mai 2012 à 15:17
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.
0

Discussions similaires

Liste des couleurs
$hawn -
squilici -

3 réponses
Recuperer la valeur d'une cellule active
cs_reynald38 -
reynald38 -

5 réponses
connexion sur une page web avec webbrowser avec login password
cs_abzim -
abzim -

5 réponses
#VB_Récupérer la valeur d'une cellule
chambreur -
chambreur -

5 réponses
Prendre la valeur d'une cellule dans excel avec vba
ndsaerith -
amigo21 -

3 réponses
Rejoignez-nous