Exporter la liste des utilisateurs
Par Romain Tiennot le mercredi 21 décembre 2011, 15:50 - VBS - Lien permanent
J'ai eu besoin d'exporter la liste d'utilisateur situé dans plusieurs sous OU. La console "Active Directory" permet d'exporter en format TXT ou CSV une liste d'utilisateur mais présent dans la même OU. Ce script concu par "Dforler" permet créer un fichier txt de votre choix dans le répertoire "C:\temp" avec la liste des utilisateurs présent dans l'OU que vous aurez indiqué. Il faut modifier la ligne "strDomainDN "
Voici le script
' ------ SCRIPT d'export d'utilisateurs depuis une OU ------ ' ------ Le domaine AD est a jouter en fixe dans le ------ ' ------ String StrDomainDN pour des raisons d'utilisations courantes ------ dim fso, MyFile, reptemp, filetext ' Attention à modifier le nom LDAP du domaine strDomainDN ="ou=direction,ou=utilisateurs,dc=tiennot,dc=lan" ' Attention le répertoire c:\temp doit exister reptemp="c:\temp\" Filetext=Inputbox("fichier temporaire de l'OU cible : ") Set fso = CreateObject("Scripting.FileSystemObject") ' création d'un fichier txt pour la première partie du script, soit le nom des utilisateurs set MyFile = fso.CreateTextFile(reptemp + filetext + ".txt") ' Ici un filtre sur les utilisateurs et je récupére leur Distinguishedname strBase = "<LDAP://" & strDomainDN & ">;" strFilter = "(&(objectclass=user)(objectcategory=person));" strAttrs = "distinguishedname;" strScope = "subtree" set objConn = CreateObject("ADODB.Connection") objConn.Provider = "ADsDSOObject" objConn.Open "Active Directory Provider" ' Ici lancement de la requêtes et écriture dans le fichier txt dans le c:\temp set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope) objRS.MoveFirst while Not objRS.EOF MyFile.WriteLine (objRS.Fields(0).Value) objRS.MoveNext wend MyFile.close ' Maintenant avec le fichier txt je récupère les informations utilisateurs par utilisateurs on error resume next Dim objConnection, objRecords, objExcel, strQuery, i, objSpread, intRow 'Attention le fichier C:\sources.xls doit exister strSheet = "c:\Source.xls" Set objExcel = CreateObject("Excel.Application") Set objSpread = objExcel.Workbooks.Open(strSheet) Set objFSO = CreateObject("Scripting.FileSystemObject") Set UserListe = objFSO.OpenTextFile(reptemp + Filetext + ".txt") 'Renseigner le numéro de la première ligne Excel ou vous souhaité écrire les inforamations i = 2 ' liste des attributs à récupérer Do Until UserListe.AtEndofStream UserLDAP = UserListe.Readline Set objUser = GetObject("LDAP://" & UserLDAP & "") CNStr = left(UserLDAP, Instr (UserLDAP, ",") -1) OuStr = Right(UserLDAP, len(UserLDAP) - Instr (UserLDAP, ",")) objExcel.ActiveSheet.Range("A" & i).Value = CNStr objExcel.ActiveSheet.Range("B" & i).Value = OuStr objExcel.ActiveSheet.Range("C" & i).Value = objUser.givenName objExcel.ActiveSheet.Range("D" & i).Value = objUser.initials objExcel.ActiveSheet.Range("E" & i).Value = objUser.sn objExcel.ActiveSheet.Range("F" & i).Value = objUser.displayName objExcel.ActiveSheet.Range("G" & i).Value = objUser.userPrincipalName objExcel.ActiveSheet.Range("H" & i).Value = objUser.SamaccountName objExcel.ActiveSheet.Range("I" & i).Value = objUser.mail objExcel.ActiveSheet.Range("J" & i).Value = objUser.physicalDeliveryOfficeName objExcel.ActiveSheet.Range("K" & i).Value = objUser.telephoneNumber objExcel.ActiveSheet.Range("L" & i).Value = objUser.Description i = i + 1 loop 'Sauvegarde du fichier Excel objExcel.ActiveWorkbook.SaveAs(reptemp + Filetext + ".xls") objExcel.ActiveWorkbook.Close objExcel.Workbooks.Close msgbox "fin de récupération des utilisateurs. Le fichiers excel est dans " + reptemp + Filetext + ".xls" objExcel.Quit
A bienôt,
Romain