neo
asked on
Create AD Account and fill fields
Hi,
I found this code from the below EE post.,
https://www.experts-exchange.com/questions/23693650/VBS-Script-Create-AD-Account-HomeDrive.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
I found this code from the below EE post.,
https://www.experts-exchange.com/questions/23693650/VBS-Script-Create-AD-Account-HomeDrive.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
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>
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.