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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 961 fois - Téléchargée 25 fois

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

Ajouter un commentaire Commentaires
Messages postés
4
Date d'inscription
lundi 19 mars 2007
Statut
Membre
Dernière intervention
8 juin 2010

bonjour, je suis intéressé par votre script, mais j'aimerais savoir comment créer mon fichier xls ?
Messages postés
14
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
21 avril 2010

Oui effectivement le script doit être lancé en local sur le serveur.
Car on ne peut pas partager le répertoire à distance (du moins je ne suis vraiment pas sur que cela soit possible)

Sinon pour strHomeFolder effectivement dans mon script original j'ai utilisé cette entrée dans le fichier excel, donc si tu ne le rajout pas il ne sert à rien.

Voilà bonne chance et bon script
Messages postés
2
Date d'inscription
mercredi 13 juin 2007
Statut
Membre
Dernière intervention
27 octobre 2007

hello, tout d'abord un grand merci pour ce script qui m'a largement inspiré pour créer le mien!
Je rencontre des problèmes pour la création du share. N'y a t'il pas une erreur dans:
objShell1.Run "%COMSPEC% /C net share " & Mystr &"=" & intsharedrive & "" & Mystr & " /unlimited"

on crée bien le share sur une machine distante? ou le script est exécuté sur la meme machine?

j'ai également remarqué que strHomeFolder n'était utilisé nul part!?

Je débute dans les scripts, donc peut-être que des détails m'ont échapés...

Merci de m'éclaircir!
Messages postés
14
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
21 avril 2010

----Attention----


Dans ma réponse à DANY93, je ne génère plus le SAMACCOUNTNAME il faut qu'il soit dans votre fichier excel ....
Messages postés
14
Date d'inscription
mercredi 15 juin 2005
Statut
Membre
Dernière intervention
21 avril 2010

Premièrement, pardon pour le délais de la réponse DANY93, mais cela pourra peut être aider quelqu'un d'autre qui voudrait utiliser le script.

La boucle de création des utilisateurs commence au premier ""Do Until ObjExcel.cells"" et fini a la dernière ""loop"" après le ""int roow = introow +1""

Sinon pour ta boucle as tu vérifier qu'il n'y avait pas de remarque devant une de ces 2 commandes ?

Autre, as-tu bien les champs demandés (nom, prénom, bureau, etc?. ) dans le cas ou tu n'es pas sur tu peux vérifier en ajoutant des remarques sur les optionnels, pour ne garder que les noms, prénoms, mdp

Comme je l'ai signalé ce script à été fait pour un besoin identifié. Puis je l'ai rapidement amélioré pour le poster (afin qu'il y ai des commentaires et qu'il soit plus compréhensif) toutefois il ne comprends pas de vérification des champs vides.

En revanche si tu remplaces la partie création de l'utilisateur, par quelque chose comme ça :(tu ne devrais plus avoir de PB)

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


'____________________________________________________________
' Creation de l'utilisateur
'____________________________________________________________

IntUserldap = Trim(objExcel.Cells(intRow, 1).Value)
IntOU = Trim(objExcel.Cells(intRow, 2).Value)
IntGivenName = Trim(objExcel.Cells(intRow, 3).Value)
Intinitials = Trim(objExcel.Cells(intRow, 4).Value)
Intsn= Trim(objExcel.Cells(intRow, 5).Value)
IntdisplayName = Trim(objExcel.Cells(intRow, 6).Value)
IntuserPrincipalName = Trim(objExcel.Cells(intRow, 7).Value)
IntSamaccountName = Trim(objExcel.Cells(intRow, 8).Value)
Intmail = Trim(objExcel.Cells(intRow, 9).Value)
IntOfficeName = Trim(objExcel.Cells(intRow, 10).Value)
InttelephoneNumber = Trim(objExcel.Cells(intRow, 11).Value)
IntADDescript = Trim(objExcel.Cells(intRow, 12).Value)
IntADMDP = "LeMotDePasse"
Intlogonscript = "leNomDuscriptDelogon"


Set objOU = GetObject("LDAP://" & IntOU )
Set objUser = objOU.Create("User", IntUserldap)


If IntUserldap <>"" then
' msgbox "le champ est :" & IntUserldap
objUser.Put "distinguishedname", IntUserldap
else
msgbox "le champ 1 du fichier excel ne doit pas être vide" & IntGivenName, IntOU, IntSamaccountName
End if

If IntSamaccountName <>"" then
' msgbox "Le champ est :" & IntSamaccountName
objUser.Put "SamaccountName", IntSamaccountName
else
msgbox "le champ 8 du fichier excel ne doit pas être vide" & IntGivenName, IntOU
End if
objUser.SetInfo


' Activation du compte / forcer le changement du MDP /
objUser.SetPassword IntADMDP
objUser.Put "pwdLastSet", -1
objUser.AccountDisabled = FALSE
objUser.SetInfo



If userPrincipalName <>"" then
objUser.put "userPrincipalName", IntuserPrincipalName
else
End if

If IntGivenName <>"" then
objUser.Put "givenName", IntGivenName
else
End if

' objUser.SetInfo


If Intsn <>"" then
objUser.Put "sn", Intsn
else
End if

If IntdisplayName <>"" then
objUser.Put "displayName", IntdisplayName
else
End if

If IntADDescript <>"" then
objUser.put "Description", IntADDescript
Else
End if

If IntOfficeName <>"" then
objUser.Put "physicalDeliveryOfficeName", IntOfficeName
Else
End if

If Intinitials <>"" then
objUser.Put "initials", Intinitials
Else
End if

If InttelephoneNumber <>"" then
objUser.Put "telephoneNumber", InttelephoneNumber
Else
End if

If Intmail <>"" then
objUser.Put "mail", Intmail
Else
End if

objUser.SetInfo


intRow = intRow + 1
Afficher les 8 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.