Solved

Create AD Account and fill fields

Posted on 2011-03-03
2
889 Views
Last Modified: 2012-05-11
Hi,

I found this code from the below EE post.,
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23693650.html?sfQueryTermInfo=1+10+30+ad+creat+script+user

Which just works great but am wondering on how to add more fields to the script as below,
Department
Manager
company
Title
Description
telephoneNumber
mail

Can someone point me to a direction on how to append these to the script ?
Thanks
<head>
	<title>Create AD User</title>
	<HTA:APPLICATION 
	     APPLICATIONNAME="Create AD User"
	     SCROLL="no"
	     SINGLEINSTANCE="yes"
	     WINDOWSTATE="maximize"
	>
	
 
<script language='vbs'>
<!--
	Option Explicit
	Dim strShare
	
    Sub Window_OnLoad
	
    	Dim strBaseConnString
    	Dim objOULevel
    	Dim intLevel
    	Dim objRootDSE
    	Dim strLoginScript
    	Dim strPassword
    	
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
    	
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		
		RecurseOUs objOULevel, 0, strBaseConnString
		
		strShare = "\\server\users$\"
		strLoginScript = "Script1.bat"
		strPassword = "d3f@ultP@55"
		
		If Right(strShare, 1) <> "\" Then strShare = strShare & "\"
		txt_homedrive.Value = strShare
		txt_LoginScript.Value = strLoginScript
		txt_Password.Value = strPassword
		
		txt_FirstName.Focus
    End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lstSiteFilter.Add objActiveOption
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
			End If
		Next
	End Sub
 
	Sub Show_Selection
		spanSiteFilter.InnerHTML = lstSiteFilter.Value
	End Sub
	
	Sub Toggle_Home_Drive
		If chk_homedrive.Checked = True Then
			txt_homedrive.disabled = False
		Else
			txt_homedrive.disabled = True
		End If
	End Sub
	
	Sub Update_Fields
		txt_LoginName.Value = ""
		txt_DisplayName.Value = ""
		If Len(txt_FirstName.Value) > 0 Then txt_LoginName.Value = Left(txt_FirstName.Value, 1)
		If Len(txt_LastName.Value) > 0 Then txt_LoginName.Value = txt_LoginName.Value & Left(txt_LastName.Value, 7)
		txt_DisplayName.Value = txt_FirstName.Value
		Update_HomeDir
	End Sub
	
	Sub Update_HomeDir
		If Len(txt_FirstName.Value) > 0 Then
			txt_DisplayName.Value = txt_FirstName.Value & " " & txt_LastName.Value
		Else
			txt_DisplayName.Value = txt_LastName.Value
		End If
		txt_HomeDrive.Value = strShare & txt_LoginName.Value
	End Sub
	
	Sub Create_User
		Dim objNewUser, objContainer, objRootLDAP, strADsPath, objRecordSet, objConnection, objCommand
		Const ADS_SCOPE_SUBTREE = 2
		
		Set objRootLDAP = GetObject("LDAP://RootDSE")
		
		Set objContainer = GetObject("LDAP://" & lstSiteFilter.Value)
		
		' Check if the user already exists
		On Error Resume Next
		Set objNewUser = GetObject("LDAP://cn=" & txt_DisplayName.Value & "," & Replace(objContainer.adsPath, "LDAP://", ""))
		If Err.Number = 0 Then
			MsgBox "User already exists:" & VbCrLf & objNewUser.adsPath
			On Error GoTo 0
		Else
			Err.Clear
			On Error GoTo 0
			
			' Now check if the username already exists
			Set objConnection = CreateObject("ADODB.Connection")
			Set objCommand = CreateObject("ADODB.Command")
			objConnection.Provider = "ADsDSOObject"
			objConnection.Open "Active Directory Provider"
			Set objCommand.ActiveConnection = objConnection
			
			objCommand.Properties("Page Size") = 1000
			objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
			
			objCommand.CommandText = "SELECT adsPath FROM 'LDAP://" & objRootLDAP.Get("defaultNamingContext") & "' " & _
				"WHERE objectCategory='user' AND samAccountName = '" & txt_LoginName.Value & "'"
			Set objRecordSet = objCommand.Execute
			
			strADsPath = ""
			While Not objRecordSet.EOF
				strADsPath = objRecordSet.Fields("adsPath").Value
				objRecordSet.MoveNext
			Wend
			
			If strADsPath <> "" Then
				MsgBox txt_LoginName.Value & " is already used as a login name for" & VbCrLf & strADsPath
			Else
				' Build the actual User.
				' Attributes listed here: http://support.microsoft.com/kb/555638
				Set objNewUser = objContainer.Create("User", "cn= " & txt_DisplayName.Value)
				objNewUser.Put "userPrincipalName", txt_LoginName.Value & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")
				objNewUser.Put "sAMAccountName", txt_LoginName.Value
				objNewUser.Put "givenName", txt_FirstName.Value
				objNewUser.Put "sn", txt_LastName.Value
				objNewUser.Put "displayName", txt_DisplayName.Value
				objNewUser.Put "scriptPath", txt_LoginScript.Value
				objNewUser.SetInfo
				objNewUser.SetPassword txt_Password.Value
				objNewUser.AccountDisabled = False
				objNewUser.SetInfo
	
				If chk_homedrive.Checked = True Then SetHomeDir
				
				MsgBox "User has been created:" & VbCrLf & objNewUser.adsPath
			End If
		End If
 
	End Sub
 
	Sub SetHomeDir
		Dim objFSO, objShell, objNetwork, strHomeDir, strCommand, strServer, strFolder, arrPath, strLocalPath
		Dim strUser, objWMIService, colItems, objItem, objNewShare, errReturn, strShareVal, bCreateNewShare
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set objNetwork = CreateObject("WScript.Network")
		
		' ** SET THIS TO TRUE TO CREATE A SHARE ON THE NEW USER FOLER
		' ** IF YOU ALREADY HAVE A SHARE ON THE PARENT FOLDER, THIS IS PROBABLY NOT REQUIRED
		bCreateNewShare = False
		
		strHomeDir = txt_homedrive.Value
		strUser = objNetwork.UserDomain & "\" & txt_loginname.Value
		If objFSO.FileExists(objFSO.GetSpecialFolder(1) & "\xcacls.vbs") = True Then
			If objFSO.FolderExists(strHomeDir) = False Then
				objFSO.CreateFolder(strHomeDir)
				' Set the permissions on the folder using XCacls.vbs downloaded from Microsoft and stored in %systemroot%\System32\
				strCommand = "%COMSPEC% /c cscript.exe " & objFSO.GetSpecialFolder(1) & "\xcacls.vbs " & strHomeDir & " /E /T /G "& strUser & ":F"
				objShell.Run strCommand, 1, True
			End If
			
			If bCreateNewShare = True Then
				' Obtain the local path to the strShare: http://www.microsoft.com/technet/scriptcenter/resources/qanda/mar06/hey0316.mspx
				strShareVal = strShare
				If Right(strShareVal, 1) = "\" Then strShareVal = Left(strShareVal, Len(strShareVal) - 1)
				arrPath = Split(Replace(strShareVal, "\\", ""), "\")
				strServer = arrPath(0)
				strFolder = arrPath(UBound(arrPath))
				Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
				Set colItems = objWMIService.ExecQuery _
				    ("Select * From Win32_Share Where Name = '" & strFolder & "'")
				strLocalPath = ""
				For Each objItem in colItems
				    ' This would return something like D:\Users
				    strLocalPath = objItem.Path
				Next
				
				If strLocalPath = "" Then
					MsgBox "Could not find share of " & strShare & " on " & strServer
				Else
					' Then create the new share on that servers local path: http://www.microsoft.com/technet/scriptcenter/resources/qanda/jan05/hey0107.mspx
					Const FILE_SHARE = 0
					Const MAXIMUM_CONNECTIONS = 25
					Set objNewShare = objWMIService.Get("Win32_Share")
					' Take the domain name off the sUser again
					sUser = Replace(sUser, sDomain & "\", "")
					errReturn = objNewShare.Create (strLocalPath & "\" & sUser, sUser, FILE_SHARE, _
					        MAXIMUM_CONNECTIONS, "Home folder share for " & sUser)
					If errReturn <> 0 Then
						MsgBox "There was an error creating the share on the folder" & VbCrLf & strServer
					End If
				End If
			End If
		Else
			MsgBox "Xcacls.vbs does not exist in the System32 folder.  Cannot create home folder."
		End If
	End Sub
-->
</script>
 
</head>
 
<body style="background-color:#B0C4DE">
	<br>
	<table width='90%' height='60%' align='center' border='0'>
		<tr>
			<td colspan="2" align="center">
				<h2>Create AD User</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>First Name: </b>
			</td>
			<td>
				<input type="text" maxlength="50" size="70" name="txt_firstname" id="txt_firstname" onchange="vbs:Update_Fields">
			</td>
		</tr>
		<tr>
			<td>
				<b>Last Name: </b>
			</td>
			<td>
				<input type="text" maxlength="50" size="70" name="txt_lastname" id="txt_lastname" onchange="vbs:Update_Fields">
			</td>
		</tr>
		<tr>
			<td>
				<b>Login Name: </b>
			</td>
			<td>
				<input type="text" maxlength="50" size="70" name="txt_loginname" id="txt_loginname" onchange="vbs:Update_HomeDir">
			</td>
		</tr>
		<tr>
			<td>
				<b>Display Name: </b>
			</td>
			<td>
				<input type="text" maxlength="100" size="130" name="txt_displayname" id="txt_displayname">
			</td>
		</tr>
		<tr>
			<td>
				<b>Login Script: </b>
			</td>
			<td>
				<input type="text" maxlength="50" size="70" name="txt_loginscript" id="txt_loginscript">
			</td>
		</tr>
		<tr>
			<td>
				<b>Create Home Drive: </b>
			</td>
			<td>
				<input type="checkbox" name="chk_homedrive" id="chk_homedrive" onclick="vbs:Toggle_Home_Drive">
			</td>
		</tr>
		<tr>
			<td>
				<b>Home Drive Path: </b>
			</td>
			<td>
				<input type="text" maxlength="100" size="130" name="txt_homedrive" id="txt_homedrive" disabled="true">
			</td>
		</tr>
		<tr>
			<td>
				<b>Password: </b>
			</td>
			<td>
				<input type="password" maxlength="50" size="70" name="txt_password" id="txt_password">
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter: </b>
			</td>
			<td>
			    <select size='1' name='lstSiteFilter'  onChange='vbs:Show_Selection'>
				</select>
			</td>
		</tr>
		<tr>
			<td>
				<b>Selected OU: </b>
			</td>
			<td>
				<span id = 'spanSiteFilter'></span>
			</td>
		</tr>
	</table>
	<br><br>
	<table width='90%' align='center' border='0'>
		<tr>
			<td align="center" width="50%">
				<button name="btn_createuser" id="btn_createuser" accessKey="C" onclick="vbs:Create_User"><u>C</u>reate User</button>
			</td>
			<td align="center" width="50%">
				<button name="btn_exit" id="btn_exit" accessKey="X" onclick="vbs:window.close">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>

Open in new window

0
Comment
Question by:kumaran16
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 5

Accepted Solution

by:
Noduzz earned 300 total points
ID: 35029460
You need to know the specific LDAP attribute and add them to the code.
try this for a list of attributes: http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm

Then once you get the attribute you want you just need to add it to your code like
objNewUser.Put "department", "IT Support"

Open in new window

or instead of "IT Support" you can just put in a variable and just add the get the department name elsewhere.

That line could go in here in your code after the objNewUser.Put "scriptPath", txt_LoginScript.Value line:
' Build the actual User.
				' Attributes listed here: http://support.microsoft.com/kb/555638
				Set objNewUser = objContainer.Create("User", "cn= " & txt_DisplayName.Value)
				objNewUser.Put "userPrincipalName", txt_LoginName.Value & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")
				objNewUser.Put "sAMAccountName", txt_LoginName.Value
				objNewUser.Put "givenName", txt_FirstName.Value
				objNewUser.Put "sn", txt_LastName.Value
				objNewUser.Put "displayName", txt_DisplayName.Value
				objNewUser.Put "scriptPath", txt_LoginScript.Value
                                  objNewUser.Put "department", "IT Support"
				objNewUser.SetInfo
				objNewUser.SetPassword txt_Password.Value
				objNewUser.AccountDisabled = False
				objNewUser.SetInfo

Open in new window

0
 
LVL 13

Assisted Solution

by:connectex
connectex earned 200 total points
ID: 35032082
Try this command line: ldifde -f users.txt -r "(objectClass=user)"

It will dump of all user information in AD to the users.txt file. You can then review the file for more guidance on which attibutes you can set for user objects.
0

Featured Post

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
Introduction During my participation as a VBScript contributor at Experts Exchange, one of the most common questions I come across is this: "I have a script that runs against only one computer. How can I make it run against a list of computers in …
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
Attackers love to prey on accounts that have privileges. Reducing privileged accounts and protecting privileged accounts therefore is paramount. Users, groups, and service accounts need to be protected to help protect the entire Active Directory …

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question