Bonjour, Voici un nouveau script toujours axè utilisateurs Active Directory.
Je sais qu? il existe des Outils pour faire quelque chose de similaire mais bon moi je ne voulais que certains attributs LDAP et puis l? exercice est toujours sympa à réaliser.
Le but du script est : Depuis une INPUTBOX (ou vous renseignerez le nom de votre OU) d? extraire l ensemble des comptes et leurs attributs (la liste est fixe mais vous pouvez en ajouter ou en retirer facilement)
J? espère qu?il est suffisamment commenté pour vous permettre de l ?utiliser ou de l? améliorer à votre bonne guise.
Voila merci (pensé à la petite notes si vous aimé ou utilisé !!!)
Source / Exemple :
' ------ 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
Stroucible=inputbox("renseigner le nom de l'ou cible : ")
' Attention à modifier le nom LDAP du domaine
strDomainDN ="ou=" & stroucible & ",dc=VotreNomdeDomaine,dc=SonExtention"
' 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