CRÉATION D'UTILISATEURS AD VIA EXCEL AVEC RAPORT DES CRÉATIONS ET DES ERREURS.

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