Script for cloning a user in AD
From: ylekiot1 (ylekiot1WyleECoyote_at_discussions.microsoft.com)
Date: 08/09/04
- Next message: Roy: "Error messages for CurrentDirectory"
- Previous message: News Groups: "ASP scripting question"
- Messages sorted by: [ date ] [ thread ]
Date: Mon, 9 Aug 2004 09:29:33 -0700
If you need the ability to clone a user in AD, check this out. It clones the
user you specify, copies the groups ( i have it set up to only copy the
groups without a group manager (groups with managers need authorization
before I add them manually)), copies the attributes that I have specified
(you can add more) replicates the new user to the off site server so the off
site server knows of the user account "out there" so it can assign
permissions to the user folder "out there" when it is created. It looks at
the user folder path on the user you are cloning and strips the server name
for mapping to that server and creating the user folder. All you enter is
the user id to clone, user id to create, first name, last name and password.
It does the rest. It puts the new user in the same OU as the user you
cloned. All of our regional office servers are DC, so the replication might
be different depending on your architecure. This script because of the
IADStools Replicasynch call need the "support tools" kit installed on the
computer running the script. I have it email me the results for logging and
debugging. Still working on the error handling but it works so far pretty
well. Leave me comments or suggestions.
'enter domain on lines 42 174 205
'line 269 needs local servernames of folders that house users homefolders
'where replication does not need to be forced
'301 302 309 need your parameters for emailing results.
'297 needs domain name for cacls user command
'283 needs destination server to recieve changes, the partition you are
pushing, and the server
'with the changes that need to be pushed
Dim strsrv2
Dim SSlist
Const ADS_PROPERTY_UPDATE = 2
Const TIMEOUT = 999
Const POPUP_TITLE = "More users?"
x=999
for i = 1 to x
Dim WSHNetwork
Set objFso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WSHNetwork = WScript.CreateObject("WScript.Network")
Set coldrives = objfso.Drives
'First see if user is already mapped to drive, if so disconnect, if user has
open window while
'looking at drive letter the disconnect will error out
For each objdrive in coldrives
if objdrive.driveletter = "R" then
WshNetwork.RemoveNetworkDrive "R:",, true
End if
Next
'Clear SSlist field in case of multiple user clones in for next loop
SSlist = ""
user2=inputbox("What USUNET user do you want To CLONE?","Please Enter User
ID")
if user2 = "" then
wscript.echo "User not Entered. Exiting."
wscript.quit
end If
'Connect to Active directory and check user to be cloned exists
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objcommand.commandtext = _
"<LDAP://ENTER YOUR DOMAIN HERE>;" & _
"(&(objectCategory=person)(objectClass=user)" & _
"(sAMAccountName=" & user2 &"));" & _
"sAMAccountName, distinguishedName;subtree"
Set objRecordSet = objCommand.Execute
If objRecordSet.RecordCount = 0 Then
WScript.Echo "The username " & user2 &" is not found in Active
Directory. Press OK to exit"
WScript.quit
Else
While Not objRecordset.EOF
'if user is found, set strusrpath to full DN name
strusrpath = objrecordset.fields("distinguishedName")
objRecordset.MoveNext
Wend
End If
user3=InputBox("What USUNET user do you want To CREATE?","Please Enter User
ID")
if user3 = "" then
wscript.echo "User not Entered. Exiting."
wscript.quit
end If
'******************************************************************************************
'Could add code here to verify user3 isn't already in AD
'******************************************************************************************
fncu=InputBox("What is the new users first name?","Please Enter First Name")
if fncu = "" then
wscript.echo "First name not Entered. Exiting."
wscript.quit
end If
lncu=InputBox("What is the new users last name?","Please Enter Last Name")
If lncu = "" then
WScript.echo "Last name not Entered. Exiting."
WScript.quit
end If
lpass=InputBox("What do you want to set " & user3 & "'s password
to?","Please Enter Password")
'****************************************************************************************************
'Could look and see if you could find code that can control password
complexity check requirements.
'Also hide password field with future IE page for entering all data instead
of message boxes.
'****************************************************************************************************
If lpass = "" Then
WScript.echo "Password not entered. Exiting."
WScript.quit
end If
Set objuser = _
GetObject("LDAP://" & strusrpath &"")
on error resume Next
firstname = objuser.Get("givenName")
homedirectory = objuser.Get("homeDirectory")
'Some remote users don't have a personal directory. Therefore prompt user
doing clone that new employee
'Will aslo not have home directory
If homedirectory = "" Then
WScript.Echo "The user you are cloning doesn't have a home directory. " &
vbcrlf & "This script uses that information" & VbCrLf & "to determine where
to create the user folder. " & vbcrlf & "The users home folder will NOT be
created."
End If
lastname = objuser.Get("sn")
offdesc = objuser.Get("description")
script = objuser.Get ("scriptPath")
'from user full dn path strip on the cn=%USERNAME% to get ou path for new
user creation
intIndex = InStr(LCase(strusrpath), "ou=")
If intIndex> 0 Then
strOU = LCase(Mid(strusrpath, intIndex))
End If
'strip home directory path to just the server name for mapping purposes,
replication (if needed)
' and path for new homedrive with new user appended
intIndex1 = InStrRev(LCase(homedirectory), "\")
If intIndex1> 0 Then
intIndex2=intIndex1 - 1
strHD = LCase(Left(homedirectory, intIndex2))
strHD1 = LCase(Left(homedirectory, intIndex1))
End If
'Pull the users home folder path and strip the fields to only the server name
' For replication statement below as server getting replication changes
intInder = InStrRev(LCase(strhd), "\")
If intInder> 0 Then
intInder1 = intInder - 1
srv = LCase(Left(strhd, intInder1))
End If
intInder2 = Len(LCase(srv))
If intInder2> 0 Then
srv1 = LCase(Mid(srv, 3, intInder2))
End If
on Error goto 0
Wscript.echo firstname & " " & lastname & " in " & offdesc & " will be
cloned and " & user3 & " " & fncu & " " & lncu & " will be created."
Set objOU = GetObject("LDAP://" & strou & "")
Set objUserCopy = objOU.Create("user", "cn=" & user3 &"")
objUserCopy.Put "sAMAccountName", user3
objUserCopy.Put "givenname", fncu
objUserCopy.Put "sn", lncu
objUserCopy.Put "userPrincipalName", user3 & "@usunet.uug.us.zurich.com"
objUserCopy.Put "displayname", fncu & " " & lncu
On Error Resume next
objUserCopy.Put "scriptPath", script
On Error goto 0
objUserCopy.SetInfo
'Create the user initially
objUserCopy.SetPassword lpass
'Set the password
objUserCopy.SetInfo
objUserCopy.Put "pwdLastSet", 0
'Enable account
objUserCopy.SetInfo
objUserCopy.AccountDisabled = False
objUserCopy.SetInfo
'Pull user account attributes over that are used here to put on new account
Set objUserTemplate = _
GetObject("LDAP://" & strusrpath &"")
On Error Resume next
arrSVAttributes = Array("department", "physicaldeliveryofficename")
arrMVAttributes = Array("description")
'On Error Resume Next
For Each strAttrib In arrSVAttributes
strValue = objUserTemplate.Get(strAttrib)
objUserCopy.Put strAttrib, strValue
Next
For Each strAttrib in arrMVAttributes
arrValue = objUserTemplate.GetEx(strAttrib)
objUserCopy.PutEx ADS_PROPERTY_UPDATE, strAttrib, arrValue
Next
objUserCopy.SetInfo
On Error goto 0
If homedirectory = "" Then
Else
'Set new users homedirectory
objusercopy.homedrive="H:"
objusercopy.homedirectory= strhd1 & user3
objusercopy.setinfo
End If
'Option Explicit
Dim objSource, objTarget, strSourceID, strTargetID, strTargetCM, objGroup,
strSourceCM
strSourceID = user2
Set objSource = GetObject("LDAP://" & strusrpath &"")
strTargetID = user3
'verify new user WAS created before continuing
Set objConnection1 = CreateObject("ADODB.Connection")
objConnection1.Open "Provider=ADsDSOObject;"
Set objCommand1 = CreateObject("ADODB.Command")
objCommand1.ActiveConnection = objConnection1
objcommand1.commandtext = _
"<LDAP://PUT YOUR DOMAIN HERE>;" & _
"(&(objectCategory=person)(objectClass=user)" & _
"(sAMAccountName=" & user3 &"));" & _
"sAMAccountName, distinguishedName;subtree"
Set objRecordSet1 = objCommand1.Execute
If objRecordSet1.RecordCount = 0 Then
WScript.Echo "The username " & user3 &" is not found in Active Directory
after user creation. Press OK to exit"
WScript.quit
Else
While Not objRecordset1.EOF
strusrpath3 = objrecordset1.fields("distinguishedName")
objRecordset1.MoveNext
Wend
End If
'get group membership and copy to user after checking group for groupmanager
'Groups with managers are specialty groups NOT to be copied over for a user
clone.
'These groups need authorization before user is added manually outside of
this script.
'Pull groups over that do not have GROUP OWNERS.
Set objTarget = GetObject("LDAP://" & strusrpath3 &"")
For Each objGroup In objSource.Groups
group3 = objGroup.name
intIndex4 = InStrRev(LCase(group3), "=")
If intIndex4> 0 Then
intIndex5 = intIndex4 + 1
strgp = LCase(Mid(group3, intIndex5))
End If
Set objConnection2 = CreateObject("ADODB.Connection")
objConnection2.Open "Provider=ADsDSOObject;"
Set objCommand2 = CreateObject("ADODB.Command")
objCommand2.ActiveConnection = objConnection2
objcommand2.commandtext = _
"<LDAP://PUT YOUR DOMAIN HERE>;" & _
"(&(objectCategory=group)(objectClass=group)" & _
"(sAMAccountName=" & strgp &"));" & _
"sAMAccountName, distinguishedName;subtree"
Set objRecordSet2 = objCommand2.Execute
If objRecordSet2.RecordCount = 0 Then
Wscript.Echo "ERROR. The group " & strgp &" *** is not found in Active
Directory. Please contact Toby"
Wscript.quit
Else
While Not objRecordset2.EOF
strgrppath = objrecordset2.fields("distinguishedName")
objRecordset2.MoveNext
Wend
End If
strmanagedby = ""
Set objGroup5 = GetObject _
("LDAP://" & strgrppath &"")
On Error Resume Next
strmanagedby = objGroup5.Get("managedby")
On Error goto 0
If strmanagedby = "" Then
SSlist1 = SSlist1 & "User " & user3 & " was added to " & strgp & VbCrLf
Else
SSlist = SSlist & "The group " & strgp & " has a group manager and will not
be added" & VbCrLf
End If
If strmanagedby = "" Then
On Error Resume Next
objGroup.Add(objTarget.AdsPath)
If Err.Number <> 0 Then
Err.Clear
On Error goto 0
SSlist3 = SSlist3 & "User " & objTarget.sAMAccountName _
& " is already be a member of " & objGroup.sAMAccountName & VbCrLf
End If
End If
objGroup.SetInfo
Next
Set objSource = Nothing
Set objTarget = Nothing
Set objGroup = Nothing
If homedirectory = "" Then
hf = "was not created due to the cloned user not having a folder defined."
Else
hf = "WAS Not created."
'map the drive for user folder creation
WSHNetwork.MapNetworkDrive "R:", strhd
on error goto 0
if objFso.folderexists("R:\" & user3 & "") Then
hf = "had already existed"
Else
set objfolder = objfso.createFolder ("r:\" & user3 &"")
hf = "was created."
end If
End If
'Does replication need to be performed?
strsrv2=ucase(srv1)
'new user acct gets sent but groups and account enable sometimes do not make
this sync
'on Wscript.sleep statement below wait for groups and account enable to
replicate on local
' servers to increase chances to make this rep sync cycle forced below
If homedirectory = "" Then
WScript.Echo "Replication does not need to be performed"
Else
if lcase(srv1) = "LOCAL SERVERNAME" Or LCase(srv1) = "LOCALSERVERNAME2" Then
'servers above are local servers that do not need replication push
WScript.Echo "Replication does not need to be performed"
Else
WScript.sleep(5000)
'WScript.echo "The users server that needs the change " & srv1 & " will be
sent the user account so the folder permissions set correctly"
'srv1 will be used for the server replication
Set comDLL=CreateObject("IADsTools.DCFunctions")
'YOU NEED TO HAVE support tools installed on pcs running this script.
Script uses IADStools functions.
'The server at the end of the next line needs to be a server that is not a
gc server but a dc
'on the local lan which will push the information in the partition (middle
parameter) to
'the server in the strsrv2 string is the server getting updated
'This needs to happen so when it comes time to set permission on the user
folder in the remote location
'the destination DC "knows" about the account and sets the perms on the
cacls statement
Result=comDLL.ReplicaSync(Cstr(strsrv2),"DC=usunet,DC=uug,DC=us,DC=zurich,DC=com","PUT DC SERVER NAME HERE that is on LAN that will push to strsrv2")
If Result = 0 Then
MsgBox "Replication completed successfully."
repl = "was successful and the user folder permissions were set."
Else
WScript.Echo "Replication Failed. The error returned was: " +
comDLL.LastErrorText
'Return error message description with iads function.
'MsgBox "Replication Failed. The User folder will NOT have the user
permissions set."
repl = "Replication Failed. The User folder will NOT have the user
permissions set."
End If
End If
End If
'If user folder exists then apply perms
if objFso.folderexists("R:\" & user3 & "") then
WSHShell.run ("CMD /C ECHO Y| CACLS R:\" & user3 & " /E /G DOMAINHERE\" &
USER3 & ":C")
wscript.sleep(6000)
END If
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "SecurityScript@yourdomain.com"
objEmail.To = "yourid@yourdomain.com"
objEmail.Subject = "User " & user3 & " Created"
objEmail.Textbody = "User " & user2 & " (" & firstname & " " & lastname &
") was cloned and " & user3 & " (" & fncu & " " & lncu & ") was created." &
VbCrLf & "The user folder " & hf & " Replication " & repl & VbCrLf & vbcrlf &
SSlist & VbCrLf & SSlist1 & vbcrlf & SSlist2 & VbCrLf
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"ENTER YOUR SMTP gateway server name here"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
objConnection.Close
objConnection1.Close
Set objShell = WScript.CreateObject("WScript.Shell")
iRetVal=objShell.Popup("Do you have more users to clone?", _
TIMEOUT,POPUP_TITLE,vbQuestion+vbYesNo)
Select Case iRetVal
Case vbNo
wscript.quit
Case vbYes
End Select
Next
- Next message: Roy: "Error messages for CurrentDirectory"
- Previous message: News Groups: "ASP scripting question"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
