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 = 100
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


...BofBienTrès BienTop ! 1 vote(s)
Loading...

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.

14 thoughts to “Excel – Extraire la liste des utilisateurs de l’Active Directory”

  1. 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|

  2. 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

  3. 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

    1. Un script genre Powershell, par exemple celui-ci pour extraire en CSV sur le bureau ?

      Get-ADComputer -Filter * -Property * | Select-Object Name,OperatingSystem,ipv4Address | Export-CSV -Path « $home\Desktop\ADComputerListing.csv » -NoTypeInformation -Encoding UTF8

  4. 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 ?

    1. Bonjour,
      Cette erreur est généralement causée quand votre AD a un/des utilisateur(s) avec un/des attribut(s) ayant un trop grand nombre de valeurs.
      Il est possible d’utiliser LDP pour connaître le nombre de valeurs d’un attribut [ex. userCertificate (500)], vous trouverez plus d’informations sur le net.

      Cordialement,

  5. 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 ! 🙂

Laisser un commentaire

Votre adresse de messagerie ne sera pas publiée. Les champs obligatoires sont indiqués avec *