Création d'utilisateurs ad via excel avec raport des créations et des erreurs.

Commenter

Contenu du snippet

Création d'utilisateurs dans l' Active Directory depuis un fichier Excel avec rapport des créations et des Erreurs.
Création automatique de son répertoire perso et partage de celui-ci. Création d'un fichier log sous format .Html pour la description du compte et de ces caractéristiques.

Voila, je dépose ce petit bout de code car ayant du créer une grande quantité de comptes sur mon AD j'avais besoin d'un script qui face les choses les plus importantes en automatique. Je ne suis qu'un novice en matière de script mais je pense qu'il ait plutôt complet (de par le contrôle d'erreur et de la génération du log) pour pouvoir être utilisé.
J'espère qu'il vous aidera à automatiser des créations utilisateurs. Car c'est ma petite contribution aux nombreux codes que j'ai le plaisir d'utiliser ou adapter à mes situations depuis que j'utilise Vbfrance

Source / Exemple : 


'============================================================================
'		Script pour L'ajout d'utilisateurs sur un domaine AD 
'			Avec creation du répertoire perso
'					par DF
'============================================================================
  on error resume next

'____________________________________________________________
' Recuperation des utilisateurs depuis un fichiers .xls
'____________________________________________________________

Dim objExcel, objSpread, intRow

strSheet = "d:\SourceFichier.xls"

Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 2 'Row 1 often contains headings

'____________________________________________________________
' debut de la boucle
'____________________________________________________________
Do Until objExcel.Cells(intRow,1).Value = ""

'____________________________________________________________
' Creation de l'utilisateur
'____________________________________________________________

IntADUserName = Trim(objExcel.Cells(intRow, 1).Value)			
	'("Recupere le prenom de l'utilisateur a creer	Exemple: Toto")
IntADSurname = Trim(objExcel.Cells(intRow, 2).Value)			
	'("Recupere le nom de l'utilisateur a creer	Exemple: Dupon")
IntADDescript = Trim(objExcel.Cells(intRow, 3).Value)			
	'("Recupere La fonction de l'utilisateur        Exemple: Hote d'accueil")
IntADOffice = Trim(objExcel.Cells(intRow, 4).Value)				
	'("Recupere description fonction")
IntADMail = Trim(objExcel.Cells(intRow, 5).Value)				
	'("Recupere le Mail")
IntADPhone = Trim(objExcel.Cells(intRow, 6).Value)				
	'("Recupere le phone")
IntOfficeOu= Trim(objExcel.Cells(intRow, 7).Value)				
	'("Recupere l'OU de destination")
IntADMDP = "Mdp00++"											
	'("Renseigner le mot de passe d'utilisateur	Exemple: User00++")
intlogonscript = "netlogon.cmd"									
	'("Renseigner le logon script")
intdomain = "Votre Domaine"										
	'("Renseigner le nom du domaine")
intsharedrive = "d:\users"										
	'("Renseigner le partage utilisateur")
IntReplog = "d:\replog"											
	'("Renseigner le repertoire pour les logs de creation utilisateurs, Attention le repertoire doit etre cree par avance")

Dim AnyString, MyStr , AnyString1, IntADUserInit, objUserVerif, termine
	AnyString  = IntADUserName      									' 1er string.
	AnyString1 = IntADSurname      										' 2eme string.
	
compteur = 1	
termine = 0
do while termine = 0

	set objuser = nothing
	MyStr = Left(trim(AnyString), compteur ) + trim (IntADSurname)  							
	'("Retourne la premiere lettre du prenom plus le nom complet dans le cas d'un doublon 
        'il rajoutera les lettres suivantes jusqu a ne plus avoir de doublon.")
	IntADUserInit = Left(AnyString, 1 ) + Left(AnyString1, 1 )									
	'("Retourne les initials Prenom+nom")

'("Attention vous devez modifier l'arborescent du domaine si dessous.dc=VOTREDOMAINE,dc=VOTRE extention ") 	
	Set objUser = GetObject("LDAP://cn="& Mystr &",ou="& IntOfficeOu &",dc=VOTREDOMAINE,dc=VOTRE extention")

	If objUser.samaccountname <> Mystr Then	
'("Verification de l existance du compte dans la meme OU, renvoi a la boucle compteur du else")
		Set objOU = GetObject("LDAP://ou="& IntOfficeOu &",dc=VOTREDOMAINE,dc=VOTRE extention")	
'("Definition de l'OU pour la creation du compte")
		Set objUser = objOU.Create("User", "cn=" & Mystr )										
'("Creation de l'user avec le login realise plus haut")

			objUser.Put "givenName", intADUserName
			objUser.Put "initials", IntADUserInit
			objUser.Put "sn", intADSurname
			objUser.Put "displayName", IntADUserName & " "	& IntADSurName
			objUser.put "Description", IntADDescript
'			objUser.Put "physicalDeliveryOfficeName", IntOfficeOu 
			objUser.Put "telephoneNumber", IntADPhone
			objUser.Put "mail", IntADMail
			objUser.put "userPrincipalName", Mystr
			objUser.Put "SamaccountName", Mystr	
			objUser.Put "ScriptPath", intlogonscript
		objUser.SetInfo
		if errorlevel <> 0 then 																
'("verification de la creation de l'utilisateur et creation d un log error en cas de probleme")
			msgbox "creation impossible pour " & Mystr
				Set fso1 = CreateObject("Scripting.FileSystemObject")
					if fso1.fileexists("" & IntReplog &""& IntADUserName &"" & IntADSurName &".error") _ 
						& then fso1.delete ("" & IntReplog &"" & IntADUserName &" " & IntADSurName &".error")
					Set MyFile = fso.CreateTextFile("" & IntReplog &"" & IntADUserName &" " & IntADSurName &".error", True)
				MyFile.Close		
		end if
						
'		Activation du compte / forcer le changement du MDP /

			objUser.SetPassword IntADMDP														'("Definir le MDP")
			objUser.Put "pwdLastSet", 0															'("Forcer le changement du MDP")
			objUser.AccountDisabled = FALSE														'("active le compte ....")
		objUser.SetInfo
		
		termine = 1

	else 
		compteur = compteur + 1
		Msgbox " un doublon existe " & Mystr & ""
	end if
loop

'____________________________________________________________
' Creation d'un fichier logs
'____________________________________________________________
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
if fso.fileexists("" & IntReplog &"" & IntADUserName &" " & IntADSurName &".htm") then fso.delete ("" & IntReplog &"" & IntADUserName &" " & IntADSurName &".htm")
Set MyFile = fso.CreateTextFile("" & IntReplog &"" & IntADUserName &" " & IntADSurName &".htm", True)
MyFile.WriteLine("<body><html><TITLE>Page retour de la cr¨¦ation d'un client</TITLE><center><br></center><br><font face=Arial size=4 color=#000066><B> Vos nom et prénom sont : <align=center>" & IntADUserName & " , " & IntADSurname _
	&"</B></font><BR><BR></p><font face=Arial size=4 color=#000066><B> Votre nom de connexion au domaine : "& intdomain &"; est : <align=center>" & Mystr _
	&"</B></font><BR><BR></p><font face=Arial size=4 color=#000066><B> Votre mot de passe  : <align=center>" & IntADMDP _
	&"</B></font><BR><BR></p><font face=Arial size=4 color=#000066><B> Votre Adresse mail est  : <align=center>" & intADMail & " " _
	&"</B></font><BR><BR></p><font face=Arial size=4 color=#000066><B> votre numero de téléphone est :" & IntADPhone & "<align=center>"_
	&"</B></font><BR><BR></p><font face=Arial size=4 color=#000066><B> Votre répertoire personnel est S:\" & MyStr & " , depuis votre poste de travail <align=center>"_
	&"</B></font><BR><BR></p><font face=Arial size=5 color=#FF6666><B> Attention !!! Vous devrez changer votre mot de passe personnel a la première connexion sur le domaine <align=center>" _
	&"</B></font><BR><BR></p><font face=Arial size=5 color=#FF6666><B> Cordialement votre service Informatique <align=center>" _
		& " </B></font><BR><BR></p></body></html>")
MyFile.Close

'____________________________________________________________
' Connexion du lecteur reseau
'____________________________________________________________
Dim objShell, objNetwork
Dim DriveLetter1, DriveLetter2, RemotePath1, RemotePath2
Dim AllDrives, AlreadyConnected, Network1, Network2, i

Set Network1 = CreateObject("WScript.Network")

DriveLetter1 = "H:" ' This letter must be in CAPITALS.

RemotePath1 = "\\VotreServeur\LesrepertoirePerso" 												
'("Renseigner le repertoire perso")

Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set AllDrives = objNetwork.EnumNetworkDrives() 

AlreadyConnected = False
For i = 0 To AllDrives.Count - 1 Step 2
If AllDrives.Item(i) = DriveLetter1 Then AlreadyConnected = True
Next

If AlreadyConnected = True then
objNetwork.RemoveNetworkDrive DriveLetter1
objNetwork.MapNetworkDrive DriveLetter1, RemotePath1

Else

objNetwork.MapNetworkDrive DriveLetter1, RemotePath1

End if 

'____________________________________________________________
' Creation du repetoire perso et creation du partage de celui ci
'____________________________________________________________

Dim objFSO, objFolder, strDirectory
strDirectory = "H:\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strHomeFolder) Then

Set objShell1 = CreateObject("WScript.Shell")
objShell1.Run "%COMSPEC% /C net share " & Mystr &"=" & intsharedrive & "\" & Mystr & " /unlimited"
objShell1.Run "%COMSPEC% /C cacls " & DriveLetter1 & "\" & Mystr & " /E /C /P administrators:F"
objShell1.Run "%COMSPEC% /C cacls " & DriveLetter1 & "\" & Mystr & " /E /C /G " & intdomain & "\" & Mystr & ":C"
objShell1.Run "%COMSPEC% /C cacls " & DriveLetter1 & "\" & Mystr & " /E /C /R everyone"

else 
set objFolder = objFSO.CreateFolder(strDirectory & mystr)
Set objShell1 = CreateObject("WScript.Shell")
objShell1.Run "%COMSPEC% /C net share " & Mystr &"=" & intsharedrive & "\" & Mystr & " /unlimited"
objShell1.Run "%COMSPEC% /C cacls " & DriveLetter1 & "\" & Mystr & " /E /C /P administrators:F"
objShell1.Run "%COMSPEC% /C cacls " & DriveLetter1 & "\" & Mystr & " /E /C /G " & intdomain & "\" & Mystr & ":C"
objShell1.Run "%COMSPEC% /C cacls " & DriveLetter1 & "\" & Mystr & " /E /C /R everyone"

end if
'____________________________________________________________
' Retour de la boucle sur la creation du repertorie perso
'____________________________________________________________

intRow = intRow + 1
Loop
msgbox "creation des utilisateurs terminee"
objExcel.Quit
set objexcel=nothing
WScript.Quit

A voir également

Du même auteur (DFORLER)