Excel – Extraire la liste des utilisateurs de l’Active Directory

Synopsis

Je vous présente aujourd’hui un Excel vraiment sympathique que j’avais trouvé sur le net il y a quelques temps, qui permet d’extraire sans droits spécifique la listes des utilisateurs de l’Active Directory via une requête LDAP.

Utilisation

Il suffit de l’ouvrir et de cliquer sur le bouton pour lancer la macro qui va nous sortir une belle liste incluant Nom, Login, Département, Société, Mail et Numéro de Téléphone … rien que ça !

Télécharger le fichier ici …

Ci-dessous la Macro pour les plus expérimentés…

Type Type_AD_Extraction
User_Name As String
User_Login As String
User_Department As String
User_Company As String
User_Mail As String
User_TelephoneNumber As String
End Type

Sub Extract_AD_UserName_And_UserLogin()
'**********************************************************
'Cette procédure extrait les propriétés
'Nom prénom et login windows
'de tous les utilisateur de l'Active Directory
'**********************************************************

Dim Tab_Query() As Type_AD_Extraction
Dim Pos_Tab_Query As Integer

'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")

'On cherche le departement
Tab_Query(Pos_Tab_Query).User_Department = GetAdsProp("cn", Tab_Query(Pos_Tab_Query).User_Name, "department", "user")

'On cherche la société
Tab_Query(Pos_Tab_Query).User_Company = GetAdsProp("cn", Tab_Query(Pos_Tab_Query).User_Name, "company", "user")

'On cherche l'adresse mail
Tab_Query(Pos_Tab_Query).User_Mail = GetAdsProp("cn", Tab_Query(Pos_Tab_Query).User_Name, "mail", "user")

'On cherche le numéro de téléphone
Tab_Query(Pos_Tab_Query).User_TelephoneNumber = GetAdsProp("cn", Tab_Query(Pos_Tab_Query).User_Name, "telephoneNumber", "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

ligne_Debut = 5

'On supprime tout
Rows(ligne_Debut).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

'On écrit le résultat
ligne = ligne_Debut
Cells(ligne, 1) = "NOM"
Cells(ligne, 2) = "LOGIN"
Cells(ligne, 3) = "DEPARTMENT"
Cells(ligne, 4) = "COMPANY"
Cells(ligne, 5) = "MAIL"
Cells(ligne, 6) = "TELEPHONE"
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
Cells(ligne, 3) = Tab_Query(Pos_Tab_Query).User_Department
Cells(ligne, 4) = Tab_Query(Pos_Tab_Query).User_Company
Cells(ligne, 5) = Tab_Query(Pos_Tab_Query).User_Mail
Cells(ligne, 6) = Tab_Query(Pos_Tab_Query).User_TelephoneNumber

ligne = ligne + 1
Next Pos_Tab_Query

'On met en page
Rows(ligne_Debut).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

Cells.Select
Selection.ColumnWidth = 10
0 Selection.RowHeight = 100 Cells.EntireRow.AutoFit Cells.EntireColumn.AutoFit Cells(1, 1).Select '************************************************************** MsgBox "Extraction terminée", vbInformation 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 If IsNull(objRecordSet.Fields(ReturnField)) = False Then GetAdsProp = objRecordSet.Fields(ReturnField) ' return value Else GetAdsProp = "" End If End If ' Close connection objConnection.Close ' Cleanup Set objRecordSet = Nothing Set objCommand = Nothing Set objConnection = Nothing End Function

Source : https://codes-sources.commentcamarche.net/profile/user/pio_killer


Mathieu

Je suis actuellement ingénieur spécialisé dans le design d'environnements cloud virtualisés. Adepte des technologies de VMware, Nutanix, Citrix et Microsoft je propose à travers ce blog diverses astuces de troubleshooting.

S’abonner
Notification pour
guest

16 Commentaires
Le plus ancien
Le plus récent Le plus populaire
Commentaires en ligne
Afficher tous les commentaires
Axel Martin
Axel Martin
8 années il y a

Hello there! Would you mind if I share your blog with my facebook group? There’s a lot of folks that I think would really appreciate your content. Please let me know. Cheers|

lachancla
lachancla
6 années il y a

what mais ! c’est trop puissant ce truc !
merci

Djanon Walter Raoul KOUADIO
Djanon Walter Raoul KOUADIO
6 années il y a

Bonsoir
Vraiment merci
c’est du balaise ce fichier, il me donne exactement ce que je recherchais
et en plus il liste par date de création dans l’AD
chapeau

SEDAGBANDE
SEDAGBANDE
5 années il y a

merci beaucoup pour ce fichier.
je voudrais savoir si vous avez un script qui pourra extrait la liste de toutes les machines de l’Active Directory.
merci

Véronique
Véronique
5 années il y a

Bonjour,

Je cherchais justement à faire un extract tel que celui-ci mais malheureusement j’ai un message d’erreur :
« The administrative limit for this request was exceeded »
AVez-vous une solution SVP ?

KVK
KVK
5 années il y a

Bonjour,

Comment peut-on faire une extraction de tous les utilisateurs (nom, prénom, service, Les numéros de téléphone de l’onglet Téléphones de l’AD) ?

Merci d’avance ! 🙂

jcg
jcg
5 années il y a

très pratique, merci

Eric
Eric
5 années il y a

Bonjour,

Comment est-il possible de savoir à quelle OU et group appartiennent les utilisateurs ?

Merci d’avance! 🙂

Patrick
Patrick
5 années il y a

Bonsoir,

Je souhaite extraire la liste des utilisateurs ainsi que leur group et OU, comment faire ?

Cordialement

Mohamed
Mohamed
4 années il y a

Waou géniale ton fichier merci

Olivier
Olivier
4 années il y a

EXTRA !!! Merci pour le partage !
T’es au top !

Olivier
Olivier
3 années il y a

Bonjour,
La solution a l’air top, sauf que j’ai ce problème de requete trop grande.
Quelqu’un a trouvé une solution pour contourner ce problème ?
merci