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
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
- Création d'utilisateurs ad via excel avec raport des créations et des erreurs.
- Visual Basic / VB.NET : [active directory] ajout utilisateurs via excel.vbs - CodeS SourceS - Guide
- Utilisation des histogrammes excel sous vb - Codes sources - Visual Basic / VB.NET (OLE, DDE, Automation)
- Détecter sa vraie adresse ip internet via excel - Codes sources - Visual Basic / VB.NET (Réseau & Internet)
- Java : Tchatcher en utilisant sms via sfr api en java - CodeS SourceS - Guide
- Utilisation de "OnKey" (EXCEL) ✓ - Forum - VBA Office (Excel, Word ...)
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
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!
Dans ma réponse à DANY93, je ne génère plus le SAMACCOUNTNAME il faut qu'il soit dans votre fichier excel ....
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
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.