Jump to content

User Creation Script

jswift17
 Share

Recommended Posts

jswift17

jswift17

Posted
Posted

So I've done some searching and there are some VERY good scripts available for creating user accounts in AD. I've grabbed a couple and started customizing them for my environment (customizing is a strong word for what I'm doing, I'm a COMPLETE noob to VB and scripting, so hacking things to pieces might be a better description :blushing: ). I've had some luck in getting certain parts of the scripts to work while other parts just won't function at all. Finally at my wits end, I had a friend who is more familiar with VB put together a small script and it it working perfectly at the moment (see script below). Now I'm getting requests to make this an HTA (which I've done with some of the other user scripts) and make things more "dynamic" (the requestors word, not mine).

Basically I'd like to create an HTA form that asks for the first and last name, user name, office (drop down list), department (drop down list as well?), manager, and has a check box for user folder creation. I've tried to create the HTA using the script my buddy created, but I'm having difficulties getting it to work correctly (probably becuase I know nothing about VB script). Later on I'm sure we'll want to add functionality for creating exchange mailboxes (exchange 2003) using a checkbox.

I've found an example that does exactly what I'm looking for, and I've changed everything I can find so it is specific to my environment (domain name, OU structure, etc), but I can't get it to work (I get no errors, it just doesn't create the user or the folder/mailbox). I'll post that code in the next message down.

Can anyone lend a hand with this?

'*****
'*** Useradd.vbs - Creates new user accounts from various popup parameters.
'***
'*****

CRLF = Chr(13) & Chr(10)
MBX_TITLE = "User Creation Script"

' Generic Access Types
const GENERIC_ALL = &H10000000
const GENERIC_EXECUTE = &H20000000
const GENERIC_WRITE = &H40000000
const GENERIC_READ = &H80000000

' Standard Access Types
const DELETE = &H00010000
const READ_CONTROL = &H00020000
const WRITE_DAC = &H00040000
const WRITE_OWNER = &H00080000
const WRITE_SYNCHRONIZE = &H00100000


' Specific Access Types for Files
const FILE_READ_DATA = &H0001
const FILE_WRITE_DATA = &H0002
const FILE_APPEND_DATA = &H0004
const FILE_READ_EA = &H0008
const FILE_WRITE_EA = &H0010
const FILE_EXECUTE = &H0020
const FILE_READ_ATTRIBUTES = &H0080
const FILE_WRITE_ATTRIBUTES = &H0100
const FILE_GENERIC_READ = &H120089
const FILE_GENERIC_WRITE = &H120116
const FILE_GENERIC_EXECUTE = &H1200A0


' File Attributes
const FILE_ATTRIBUTE_READONLY = &H1
const FILE_ATTRIBUTE_HIDDEN = &H2
const FILE_ATTRIBUTE_SYSTEM = &H4
const FILE_ATTRIBUTE_DIRECTORY = &H10
const FILE_ATTRIBUTE_ARCHIVE = &H20
const FILE_ATTRIBUTE_NORMAL = &H80
const FILE_ATTRIBUTE_TEMPORARY = &H100
const FILE_ATTRIBUTE_COMPRESSED = &H800

'Specify Default NT Permisions
RWXD = GENERIC_READ + GENERIC_WRITE + GENERIC_EXECUTE + DELETE

Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 25


'*** Declare variables used throughout the script.

Public DomName
Public HomeServer
Public FirstName
Public LastName
Public UserName
Public Office
Public Department
Public Phone
Public Debug
Public Network
Public GroupName
Public HomeShare
Public AM
Public Driveletter
Public InitialPassword
Public UserDataDir
Public UserDirectoriesPath

Dim bCancelled

MsgBox_Title_Text = "User Account Creation Script"
HomeServer = "server1"
UserDataDir = "sys1user"
UserDirectoriesPath = "e:sys1user"
InitialPassword = "P@ssword"
LogonScript = "logon.bat"
DomName = "domain.local"
UserContainer = "OU=location1,OU=Sites"
Company = "Company"
Office = "Office1"
Debug = True
bCancelled = True

   '*** Prompt for user specific info

  'wscript.echo "Please note that all fields need to be filled out! If don't know it, just put n/a. A blank field will cause the script to fail!"




   FirstName = InputBox("Enter the user's first name:")
   If FirstName <> "" Then 
	  LastName = InputBox("Enter the user's last name:")
	  If LastName <> "" Then
		 HomeServer = FirstCharToUCase(HomeServer)
		 FirstName = FirstCharToUCase(FirstName)
		 LastName = FirstCharToUCase(LastName)
		 UserName = ""
		 UserName = InputBox("Enter user's logon id:", "Logon ID", UserName )
		 If UserName <> "" Then
			Department = InputBox("Enter the user's Department:")
			If Department <> "" Then
			   'UserShare = "" & HomeServer & "" & UserDataDir & "" & UserName & "$"
			   root = "WinNT://" & HomeServer & "/"

			   Set Shell = WScript.CreateObject("WScript.Shell")

			   'On error resume next

			   Verify = Ask("The following information will be used to create the user account" & CRLF & CRLF & "User Name: " & Username & CRLF & "Full Name: " & FirstName & " " & LastName & CRLF & "Description: " & Department  & CRLF & "Home Server: " & HomeServer & CRLF & "Home Directory: " & HomeServer & "sys1User"  & UserName  & CRLF & CRLF & CRLF & CRLF & "Is all of the information correct, and do you wish to continue?" & CRLF & CRLF & CRLF & "The user's password will be: " & InitialPassword)

				 If Verify = vbYes Then

				  CreateUser UserName, FirstName, LastName
				  CreateHomeDirectory UserName, HomeServer, UserDataDir, UserDirectoriesPath
				  wscript.echo "User Created!"
				  bCancelled = False

			   End If 'If Verify = vbYes
			End If 'If Department <> ""	  
		 End If 'If UserName <> ""		 
	  End If 'if LastName <> ""			
   End If 'if FirstName <>""

   If bCancelled = True Then 
	  wscript.echo "User Creation Cancelled!"
   End If

'************************************************************************************************
********
Sub CreateUser(ByVal UserName, ByVal FirstName, ByVal LastName )

   Dim objDomain
   dim objUser
   dim HomeShare
   dim UserHome
   Dim sFullName


   'on error resume next

   'Set objRootDSE = GetObject("LDAP://" & HomeServer & "/rootDSE")
   'Set objContainer = GetObject("LDAP://"OU=location1,OU=Sites" & objRootDSE.Get("defaultNamingContext"))

   Set objDomain = GetObject("LDAP://" & DomName )

   sFullName = LastName & ", " & FirstName
   Set objUser = objDomain.Create("User","CN=" & sFullName & "," & UserContainer )

   objUser.put "SAMAccountName", UserName
   objUser.put "givenName", Trim(Firstname)
   objUser.put "sn", Trim(LastName)
   objUser.put "userPrincipalName", UserName & "@domain.local"
   objUser.put "displayName", LastName & ", " & FirstName
   objUser.put "company", Company
   objUser.put "physicalDeliveryOfficeName", Office


   objUser.LoginScript = LogonScript
   objUser.Description = Department
   objUser.SetInfo


   objUser.SetPassword InitialPassword
   objUser.accountdisabled = false
   objUser.put "pwdLastSet", 0

   objUser.SetInfo




   'HomeShare = UserName & "$"
   'UserHome = "" & HomeServer & "" & HomeShare
   UserHome = "" & HomeServer & "sys1User" & UserName

   objUser.put "HomeDirectory", UserHome
   objUser.put "HomeDrive","P:"
   objUser.SetInfo



   objUser.put "PwdLastSet", 0
   objUser.SetInfo

   set objUser = nothing
   set objDomain = nothing


End Sub


'************************************************************************************************
********
Sub CreateHomeDirectory(ByVal UserName, ByVal HomeServer, ByVal UserDataDir, ByVal PhysicalPathToUserDirs )

   Dim strComputer
   Dim objWMIService
   Dim objNewShare
   Dim errReturn
   Dim HomeFolder

   on error resume next

   HomeFolder = "" & HomeServer & "" & UserDataDir & "" & UserName

   'Create the folder
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.CreateFolder(HomeFolder)


   Set objShell = CreateObject("WScript.Shell")

   'Set NTFS Permisssions
   'Make Administrators Owner
   strCommand = "%COMSPEC% /c xcacls " & HomeFolder & " /T /C /E /G Administrators:C"
   intRunError = objShell.Run( strCommand, 2, True)

   'Assign full access to user
   strCommand = "%COMSPEC% /c xcacls " & HomeFolder & " /T /C /E /G " & "Company" & UserName & ":F" 
   intRunError = objShell.Run( strCommand, 2, True)

   'Remove ALL rights from Everyone group
   strCommand = "%COMSPEC% /c xcacls " & HomeFolder & " /T /C /E /R Everyone"	
   intRunError = objShell.Run( strCommand, 2, True)




   'Create the share
   'Set objWMIService = GetObject("winmgmts:" _
   '& "{impersonationLevel=impersonate}!" & HomeServer & "rootcimv2")

   'Set objNewShare = objWMIService.Get("Win32_Share")

   'errReturn = objNewShare.Create _
   '(PhysicalPathToUserDirs & "" & UserName, UserName & "$", FILE_SHARE, _
   'MAXIMUM_CONNECTIONS, "User Share")



End Sub


'************************************************************************************************
********
function CreateLogonName(FirstName, LastName)

   CreateLogonName = Left(LastName,9) & Left(FirstName,1)

End function

'************************************************************************************************
********
Function Proper (TextIn)
   Proper = UCase(left(TextIn,1)) & LCase(mid(TextIn,2))
End Function


'************************************************************************************************
********
Function Ask(strAction)
   Dim intButton
   intButton = MsgBox(strAction,vbQuestion + vbYesNo, MsgBox_Title_Text )
   Ask = intButton 
End Function

'************************************************************************************************
********
Function FirstCharToUCase(StrUpper)

   Dim Temp1
   Dim Temp2

   Temp1 = Ucase(Left(StrUpper,1))
   Temp2 = LCase(Right(StrUpper,Len(StrUpper)-1))

   FirstCharToUCase = Temp1 & Temp2

End Function

Here is the code from the sample HTA I've been trying to customize. I would prefer to use xcacls instead of SetACL if possible (I'm just more familiar with that program).

<html> 
<head> 
<title>User Account Creation Form v1.0</title> 
<HTA:APPLICATION 
ID = "AccountCreationApp" 
APPLICATIONNAME="Account Creation" 
BORDER = "thin" 
CAPTION = "yes" 
RESIZE = "no" 
ICON = "Msn-Messenger.ico" 
SHOWINTASKBAR = "yes" 
SINGLEINSTANCE = "yes" 
SYSMENU = "Yes" 
WINDOWSTATE = "normal" 
SCROLL = "yes" 
SCROLLFLAT = "yes" 
VERSION = "1.0" 
INNERBORDER = "no" 
SELECTION = "no" 
MAXIMIZEBUTTON = "no" 
MINIMIZEBUTTON = "yes" 
NAVIGABLE = "yes" 
CONTEXTMENU = "yes" 
BORDERSTYLE = "normal"> 
</hta> 
<style> 
BODY 
background-color: #E5ECF9; 
font-family: Helvetica; 
font-size: 8pt; 
margin-top: 10px; 
margin-left: 20px; 
margin-right: 10px; 
margin-bottom: 10px; 
scrollbar-track-color: #E5ECF9; 
scrollbar-3dlight-color: #E5ECF9; 
scrollbar-arrow-color: #E5ECF9; 
scrollbar-base-color: #E5ECF9; 
scrollbar-darkshadow-color: #E5ECF9; 
scrollbar-face-color: #E5ECF9; 
scrollbar-highlight-color: #E5ECF9; 
scrollbar-shadow-color: #E5ECF9 
} 
TD 
{ 
font-family: Trebuchet MS; 
font-size: 8pt; 
} 
LEGEND 
{ 
font-family: Trebuchet MS; 
font-size: 10pt; 
} 
SELECT 
{ 
font-family: Trebuchet MS; 
font-size: 8pt; 
width:195px 
} 
INPUT 
{ 
font-family: Trebuchet MS; 
font-size: 8pt; 
} 
</style> 


<script language="VBScript"> 
Dim defaultNC, BaseOU 
defaultNC = GetObject("LDAP://RootDSE").Get("DefaultNamingContext") 
BaseOU = "OU=Sites," & defaultNC 
Logpath ="C:logs" 
Const FORAPPENDING = 8 

Sub Window_OnLoad 
Dim width, height, x, y
width = 770
height = 690
x = (window.screen.width - width) / 2 
y = (window.screen.height - height) / 2 
If x < 0 Then x = 0 
If y < 0 Then y = 0 
window.resizeTo width,height 
window.moveTo x,y
'Check if this HTA is running under the correct account
Set wshNetwork = CreateObject("WScript.Network")
strComputer = wshNetwork.ComputerName
strCurrentDomain = wshNetwork.UserDomain
strCurrentUser = wshNetwork.UserName
strRequiredDomain = "Domain"
strRequiredUser = "Administrator"
strHTAPath = Replace(Mid(Document.URL, 8), "%20", " ")
If Left(strHTAPath, 2) <> "" And Left(strHTAPath, 2) <> "C:" Then
	  MsgBox "Please run this program from a local drive or a UNC path"
	  Window.Close
	  Exit Sub
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(strRequiredDomain & "" & strRequiredUser) <> LCase(strCurrentDomain & "" & strCurrentUser) Then
	  strRequiredPassword = InputBox("This program is not running under the user account of " & strRequiredDomain & "" & strRequiredUser & "." & VbCrLf &_
			"Please enter the password for the required account, and the program will be restarted:", "Incorrect User")
	  strPSExecPath = "Server2netlogonpsexec.exe"
	  strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula " & strComputer & " -i -d -u " & strRequiredDomain & "" & strRequiredUser & " -p " & strRequiredPassword & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
	  'InputBox "Prompt", "Title", strCommand
	  Set objShell = CreateObject("WScript.Shell")
	  objShell.Run strCommand, 0, False
	  Window.Close
End If
Call Populate_Office
Call Populate_Domain_Controllers
Call Populate_Exchange_Servers
End Sub 

Sub Populate_Office()

	  strHTML = "<select size='1' name='cbxSite'>" & VbCrLf

	  Set objFSO = CreateObject("Scripting.FileSystemObject")
	  strRootPath = Replace(Mid(Document.URL, 8), "%20", " ")
	  strRootPath = Left(strRootPath, InStrRev(strRootPath, ""))
	  strOfficeFile = strRootPath & "OfficeLocations.txt"
	  If objFSO.FileExists(strOfficeFile) = False Then
			MsgBox strOfficeFile & " not found.  Cannot create Office Locations."
			Exit Sub
	  End If

	  Set objOfficeFile = objFSO.OpenTextFile(strOfficeFile, 1, False)
	  While Not objOfficeFile.AtEndOfStream
			strOffice = objOfficeFile.ReadLine
			If strOffice <> "" Then
				  strHTML = strHTML & "<option value='" & strOffice & "'>" & strOffice & "</option>" & vbCrLf
			End If
	  Wend
	  objOfficeFile.Close

	  strHTML = strHTML & "<option selected value='cbxOfficeAlert'>-- Select Users Office --</option>" & vbCrLf
	  strHTML = strHTML & "</select>"

	  span_Office.InnerHTML = strHTML

	  Set objOfficeFile = Nothing
	  Set objFSO = Nothing
End Sub

Sub Populate_Domain_Controllers()

	  strHTML = "<select size='1' name='cbxDCServer'>" & VbCrLf

	  Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
	  Dim adoRecordset, objDC, objSite

	  ' Determine configuration context from RootDSE object.
	  Set objRootDSE = GetObject("LDAP://RootDSE")
	  strConfig = objRootDSE.Get("configurationNamingContext")

	  ' Use ADO to search Active Directory for ObjectClass nTDSDSA.
	  Set adoCommand = CreateObject("ADODB.Command")
	  Set adoConnection = CreateObject("ADODB.Connection")
	  adoConnection.Provider = "ADsDSOObject"
	  adoConnection.Open "Active Directory Provider"
	  adoCommand.ActiveConnection = adoConnection

	  strQuery = "<LDAP://" & strConfig _
		  & ">;(ObjectClass=nTDSDSA);AdsPath;subtree"

	  adoCommand.CommandText = strQuery
	  adoCommand.Properties("Page Size") = 100
	  adoCommand.Properties("Timeout") = 30
	  adoCommand.Properties("Cache Results") = False

	  Set adoRecordset = adoCommand.Execute

	  ' The parent object of each object with ObjectClass=nTDSDSA is a Domain
	  ' Controller. The parent of each Domain Controller is a "Servers"
	  ' container, and the parent of this container is the "Site" container.
	  Do Until adoRecordset.EOF
		  Set objDC = GetObject( _
			  GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
		  Set objSite = GetObject(GetObject(objDC.Parent).Parent)
				  strHTML = strHTML & "<option value='" & objDC.cn & "'>" & objDC.cn & "</option>" & VbCrLf
		  'Wscript.Echo "Domain Controller: " & objDC.cn & vbCrLf _
		  '   & "DNS Host Name: " & objDC.DNSHostName & vbCrLf _
		  '   & "Site: " & objSite.name
		  adoRecordset.MoveNext
	  Loop
	  adoRecordset.Close

	  strHTML = strHTML & "<option selected value='cbxDCServerAlert'>-- Select DC Server --</option>" & vbCrLf
	  strHTML = strHTML & "</select>"
	  span_DCServer.InnerHTML = strHTML

	  ' Clean up.
	  adoConnection.Close
	  Set objRootDSE = Nothing
	  Set adoCommand = Nothing
	  Set adoConnection = Nothing
	  Set adoRecordset = Nothing
	  Set objDC = Nothing
	  Set objSite = Nothing
End Sub

Sub Populate_Exchange_Servers()

	  ' POPULATE THE EXCHANGE SERVER LIST BOX

	  strHTML = "<select size='1' name='cbxExchServer' onChange='Populate_StorageGroups()'>" & vbCrLf
	  Set cn = createobject("ADODB.Connection")
	  Set cmd = createobject("ADODB.Command")
	  Set rs = createobject("ADODB.Recordset")
	  Set objRoot = getobject("LDAP://RootDSE")
	  configurationNC = objRoot.Get("configurationnamingcontext")
	  cn.open "Provider=ADsDSOObject;"
	  cmd.activeconnection = cn
	  cmd.commandtext = "<LDAP://" & configurationNC & _
					">;(objectCategory=msExchExchangeServer);name;subtree"
	  Set rs = cmd.execute
	  While rs.eof <> True And rs.bof <> True
			strHTML = strHTML & "<option value='" & rs(0) & "'>" & rs(0) & "</option>" & VbCrLf
			rs.movenext
	  Wend
	  cn.close
	  strHTML = strHTML & "<option selected value='cbxExchServerAlert'>-- Select Exchange Server --</option>" & vbCrLf
	  strHTML = strHTML & "</select>"
	  span_ExchServer.InnerHTML = strHTML

End Sub

Sub Populate_StorageGroups()
'THIS PROCEDURE POPULATE THE cbxStorageGroup and cbxExch List Boxes
' for the Storage Group and the Mailstore
	  strHTML = "<select size='1' name='cbxStorageGrp' onChange='Populate_MailStores()'>" & VbCrLf
	  Dim objRootDSE,objConfiguration
	  Dim cat,conn
	  Dim cmd,RS
	  Set objRootDSE = GetObject("LDAP://rootDSE")
	  x=1
	  strSrv=cbxExchServer.Value
	  strConfiguration = "LDAP://" & objRootDSE.Get("configurationNamingContext")
	  Set objConfiguration = GetObject(strConfiguration)
	  strQuery="Select name,cn,distinguishedname from '" & _
	  objConfiguration.ADSPath & "' Where objectclass='msExchStorageGroup'"	  
	  set cat=GetObject("GC:")
	  for each obj in cat
	   set GC=obj
	  Next
	  AdsPath=GC.ADSPath
	  set conn=Createobject("ADODB.Connection")
	  set cmd=CreateObject("ADODB.Command")
	  conn.Provider="ADSDSOObject"
	  conn.Open	  
	  set cmd.ActiveConnection=conn
	  set RS=conn.Execute(strQuery)
	  'WScript.Echo "Mailbox stores on " & UCase(strSrv) & ":"
	  Do while not RS.EOF
			 DN=rs.Fields("distinguishedname")
			 'CN=RS.Fields("cn")
			 NM=RS.Fields("name")
			 If InStr(UCase(DN),UCase(strSrv)) Then 
				  'WScript.Echo x & ") " &DN
				  'WScript.Echo "Name: " & NM
				  'WScript.Echo "CN: " & cn
						strHTML = strHTML & "<option value='" & NM & "'>" & NM & "</option>" & VbCrLf
				  x=x+1
			End If
			rs.movenext
	  Loop
	  rs.Close
	  conn.Close
	  strHTML = strHTML & "<option selected value='cbxStorageGrpAlert'>-- Select Storage Group --</option>" & vbCrLf
	  strHTML = strHTML & "</select>"
	  span_StorageGroup.InnerHTML = strHTML

End Sub

Sub Populate_MailStores()
	  strHTML = "<select size='1' name='cbxExch'>" & VbCrLf

	  'Dim objRootDSE,objConfiguration
	  'Dim cat,conn
	  'Dim cmd,RS
	  Set objRootDSE = GetObject("LDAP://rootDSE")
	  x=1
	  strSrv = cbxExchServer.Value
	  strConfiguration = "LDAP://" & objRootDSE.Get("configurationNamingContext")
	  Set objConfiguration = GetObject(strConfiguration)
	  strQuery="Select name,cn,distinguishedname from '" & _
	  objConfiguration.ADSPath & "' Where objectclass='msExchPrivateMDB'"	  
	  set cat=GetObject("GC:")
	  for each obj In cat
	   set GC=obj
	  Next
	  AdsPath=GC.ADSPath
	  set conn=Createobject("ADODB.Connection")
	  set cmd=CreateObject("ADODB.Command")
	  conn.Provider="ADSDSOObject"
	  conn.Open	  
	  set cmd.ActiveConnection=conn
	  set RS=conn.Execute(strQuery)
	  'WScript.Echo "Storage groups on " & UCase(strSrv) & ":"
	  Do while not RS.EOF
			DN=rs.Fields("distinguishedname")
			CN=RS.Fields("cn")
			NM=RS.Fields("name")
			If InStr(UCase(DN),UCase(strSrv)) And InStr(UCase(DN),UCase(cbxStorageGrp.Value)) Then
				  strHTML = strHTML & "<option value='" & NM & "'>" & NM & "</option>" & VbCrLf
'				  WScript.Echo x & ") " &DN
'				  WScript.Echo "Name: " & NM
'				  WScript.Echo "CN: " & CN
				  x=x+1
			End If
			rs.movenext
	  Loop
	  rs.Close
	  conn.Close	  
	  Set objRootDSE=Nothing
	  Set objConfiguration=Nothing
	  Set cat=Nothing
	  Set conn=Nothing
	  Set cmd=Nothing
	  Set RS=Nothing

	  strHTML = strHTML & "<option selected value='cbxExchAlert'>-- Select Server/Mailstore --</option>" & VbCrLf
	  strHTML = strHTML & "</select>"
	  span_cbxExch.InnerHTML = strHTML
End Sub

Sub chkExch_OnClick() 
If chkExch.checked = True Then 
cbxExch.Disabled = 0 
Else 
cbxExch.Disabled = 1 
End If 
End Sub 
Sub chkDL_OnClick() 
If chkDL.checked = True Then 
cbxDL.Disabled = 1 
Else 
cbxDL.Disabled = 0 
End If 
End Sub 



' ## Start user account creation process ## 
Sub CreateAccount 
	  strUser = txtUser.Value 
	  If strUser = "" Then 
			MsgBox "You are missing required fields.",64, "Alert" 
			Exit Sub 
	  End If 
	  strFirst = txtFirst.Value 
	  If strFirst = "" Then 
			MsgBox "You are missing required fields.",64, "Alert" 
			Exit Sub 
	  End If 
	  strInitial = txtMiddle.Value 
	  strLast = txtLast.Value 
	  If strLast = "" Then 
			MsgBox "You are missing required fields.",64, "Alert" 
			Exit Sub 
	  End If 
	  strDisplay = UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) & " " _ 
			& UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1)) 
	  strTitle = txtTitle.Value 
	  strOffice = cbxSite.Value 
	  strDepartment = txtDepartment.Value 
	  strCompany = txtCompany.Value 
	  strManager = txtManager.Value 
	  strCN = UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) & " " _ 
			& UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1)) 
	  Set objConnection = CreateObject("ADODB.Connection") 
	  objConnection.Open "Provider=ADsDSOObject;" 
	  Set objCommand = CreateObject("ADODB.Command") 
	  objCommand.ActiveConnection = objConnection 
	  objCommand.CommandText = _ 
	  "<GC://" & defaultNC & ">;(&(objectCategory=Person)(objectClass=user)" & _ 
	  "(samAccountName=" & strUser & "));samAccountName;subtree" 
	  Set objRecordSet = objCommand.Execute 
	  If objRecordSet.RecordCount = 0 Then 
	  Else 
	  MsgBox "The User Account already exists.",48,"Alert" 
	  Exit Sub 
	  End If 
	  objConnection.Close 

	  Const FORWRITING= 2 
	  Const ADS_UF_ACCOUNTDISABLE = 2 
	  Const ADS_PROPERTY_UPDATE = 2 
	  Const ADS_PROPERTY_APPEND = 3 

	  ' ## Determine if Creation of User Mailbox required ## 
	  If chkExch.checked = "True" And cbxExch.value = "cbxExchAlert" Then 
	  MsgBox "You must select either a Server/Mailstore or " & vbcrlf _ 
	  & "de-select the 'Create Mailbox' checkbox." ,64, "Alert" 
	  Exit Sub 
	  End If 
	  ' ## Add user to required Distribution List ## 
	  If chkDL.checked ="True" And cbxDL.value = "cbxDLAlert" Then 
	  MsgBox "You must select a Distribution List or " & vbcrlf _ 
	  & "de-select the 'Distribution List' checkbox." ,64, "Alert" 
	  Exit Sub 
	  End If 
	  ' ## Ensure users site/office selected ## 
	  If cbxSite.Value = "cbxOfficeAlert" Then 
	  MsgBox "You must select the users office.",64, "Alert" 
	  Exit Sub 
	  End If 
	  Select Case cbxSite.Value 
	  Case "Cloquet" 
strOffice = "Cloquet" 
strLDAPdn = "OU=Cloquet," & BaseOU 
strUserServer = "Cloquet" 
Case "Closure" 
strOffice = "Closure" 
strLDAPdn = "OU=Closure," & BaseOU 
strUserServer = "Closure" 
strUserPath = "user"
Case "Daleville" 
strOffice = "Daleville" 
strLDAPdn = "OU=Daleville," & BaseOU 
strUserServer = "Daleville" 
strUserPath = "sys1user"
Case "Independence"
strOffice = "Independence" 
strLDAPdn = "OU=Independence," & BaseOU 
strUserServer = "Indenpendence"
Case "Richmond Hill" 
strOffice = "Richmond Hill" 
strLDAPdn = "OU=Richmond Hill," & BaseOU 
strUserServer = "RichmondHill" 
Case "Remote Users" 
strOffice = "Remote Users" 
strLDAPdn = "OU=Remote Users" & BaseOU 
strUserServer = "REMOTE" 
Case "Wilton" 
strOffice = "Wilton" 
strLDAPdn = "OU=Wilton" & BaseOU 
strUserServer = "Wilton" 
Case "Firelog - Birmingham" 
strOffice = "Firelog - Birmingham" 
strLDAPdn = "OU=Birmingham, OU=Firelog" & BaseOU 
Case "Firelog - Greenville" 
strOffice = "Firelog - Greenville" 
strLDAPdn = "OU=Greenville, OU=Firelog" & BaseOU 
Case "Firelog - Kitchener" 
strOffice = "Firelog - Kitchener" 
strLDAPdn = "OU=Kitchener, OU=Firelog" & BaseOU 
Case "Firelog - Remote Users" 
strOffice = "Firelog - Remote Users" 
strLDAPdn = "OU=Remote Users, OU=Firelog" & BaseOU 
Case "Firelog - Sacremento Office" 
strOffice = "Firelog - Sacremento Office" 
strLDAPdn = "OU=Sacremento - Ofc, OU=Firelog" & BaseOU 
Case "Firelog - Sacremento Warehouse" 
strOffice = "Firelog - Sacremento Warehouse" 
strLDAPdn = "OU=Sacremento - WH, OU=Firelog" & BaseOU 
Case "Firelog - Spring Hope" 
strOffice = "Firelog - Spring Hope" 
strLDAPdn = "OU=Spring Hope, OU=Firelog" & BaseOU 
	  End Select 

	  Set objOU = GetObject("LDAP://" & strLDAPdn) 
	  Set objUser = objOU.Create("User", "cn=" & strCN) 

	  objUser.Put "sAMAccountName", LCase(strUser) 
	  objUser.SetInfo 
	  objUser.Put "givenName", UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1)) 
	  If strInitial <> "" Then 
	  objUser.Put "initials", UCase(Left(strInitial, 1)) & LCase(Right(strInitial, Len(strInitial) - 1)) 
	  End If 
	  objUser.Put "sn", UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) 
	  objUser.Put "displayName", UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) & " " _ 
	  & UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1)) 

	  If strTitle <> "" Then 
	  objUser.put "title", strTitle 
	  End If 
	  If strDepartment <> "" Then 
	  objUser.put "department", strDepartment 
	  End If 
	  If strCompany <> "" Then 
	  objUser.put "company", strCompany 
	  End If 
	  If strManager <> "" Then 
	  objUser.put "manager", strManager 
	  End If 
	  objUser.put "physicalDeliveryOfficeName", strOffice 
	  objUser.put "description", strTitle 
	  objUser.Put "userPrincipalName", LCase(strUser) & "@" & defaultNC 

	  objUser.SetPassword "welcome" 
	  objUser.Put "pwdLastSet", 0 

	  intUAC = objUser.Get("userAccountControl") 
	  If intUAC And ADS_UF_ACCOUNTDISABLE Then 
	  objUser.Put"userAccountControl", intUAC Xor ADS_UF_ACCOUNTDISABLE 
	  End If 
	  objUser.SetInfo 
	  ' ## Add Users to selected groups ## 
	  If chkGrpOne.Checked Then 
	  Set objGroup = GetObject _ 
	  ("LDAP://cn=NPFIT,OU=Other Mail-enabled Security Groups,OU=Groups,OU=__ Migration Staging," & BaseOU) 
	  objGroup.PutEx ADS_PROPERTY_APPEND, _ 
	  "member", Array("cn=" & strCN & "," & strLDAPdn) 
	  objGroup.SetInfo 
	  End If 

	  If chkGrpTwo.Checked Then 
	  Set objGroup = GetObject _ 
	  ("LDAP://cn=Share - NPSO Files,OU=File Share Access,OU=Groups,OU=__ Migration Staging," & BaseOU) 
	  objGroup.PutEx ADS_PROPERTY_APPEND, _ 
	  "member", Array("cn=" & strCN & "," & strLDAPdn) 
	  objGroup.SetInfo 
	  End If 

	  If chkGrpThree.Checked Then 
	  Set objGroup = GetObject _ 
	  ("LDAP://cn=Shared Data,OU=Universal Security,OU=Groups (Don't Migrate?),OU=_ Migration Staging - DO NOT MOVE OR ADD OBJECTS HERE!," & defaultNC) 
	  objGroup.PutEx ADS_PROPERTY_APPEND, _ 
	  "member", Array("cn=" & strCN & "," & strLDAPdn) 
	  objGroup.SetInfo 
	  End If 
	  ' ## Create User Mailbox Process ## 

	  If ChkExch.Checked Then 
	  Call CreateMailbox (strCN,strLDAPdn) 
	  End If 
	  ' ## Create User Folder Process ## 
	  If chkUserFolder.Checked Then 
	  Call CreateUserFolder (strUser,strUserServer) 
	  End If 
	  ' ## Writes entry into logfile ## 
	  If chkLogging.Checked Then 
	  WriteLog("Account Created: " & DateToStr() & ", " & Time() & ", " & strUser _ 
	  & ", " & strFirst & " " & strLast & ", " & strOffice) 
	  End If 
	  ' ## Reloads Page on completion of User Creation ## 
	  Location.Reload(True) 
	  MsgBox "User Successfully Created.",64, "Alert - User Creation Successful." 
End Sub



Sub CreateMailbox (strCN,strLDAPdn) 
	  ' ## Start Mail Account Creation Process ## 

	  Dim oIADSUser 
	  Dim strMStore 
	  Set oIADSUser = GetObject("LDAP://cn=" & strCN & "," & strLDAPdn) 
	  ' ## EXCHANGE MAIL STORES ## 
	  Select Case cbxExch.Value 
	  Case "JHB" 
	  strExchServer = "JHB00ITEX03" 
	  strMStore = "Mailbox Store (JHB00ITEX03)" 
	  strStoreGP = "First Storage Group" 
	  Case "JBC" 
	  strExchServer = "JHB00ITEX03" 
	  strMStore = "JBC Mailbox Store" 
	  strStoreGP = "JBC" 
	  Case "JHB" 
	  strExchServer = "JHB00ITEX03" 
	  strMStore = "JHB Mailbox Store" 
	  strStoreGP = "JHB" 
	  Case "USPC" 
	  strExchServer = "JHB00ITEX03" 
	  strMStore = "USPC Mailbox Store" 
	  strStoreGP = "USPC" 
	  End Select 

	  oIADSUser.CreateMailbox ("LDAP://CN=" & strMStore & ",CN=" & strStoreGP & ",CN=InformationStore,CN=" & strExchServer & ",CN=Servers,CN=JHB,CN=Administrative Groups,CN=ECXORG (Exchange),CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=jhb,DC=jarden,DC=local") 
	  oIADSUser.SetInfo 
	  ' ## End of Mail Account Creation Process ## 
End Sub 




Sub CreateUserFolder (strUser,strUserServer) 
' ## Create the Users home folder on respective server ## 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder("" & strUserServer & "sys1users") 
' ## Create users home folder ## 
If objFSO.FolderExists("" & strUserServer & "sys1users" & strUser) = False Then 
objFSO.CreateFolder("" & strUserServer & "sys1users" & LCase(strUser)) 
End If 

' ## Assign user change NTFS permissions on home drives ## 
Set objShell = CreateObject("Wscript.Shell") 
strUserFolder = "" & strUserServer & "sys1users" & strUser 
objShell.Run ("SetACL.exe -on """ & strUserFolder & """ -ot file -actn ace " & "-ace ""n:jhb.jarden.local" & strUser & ";p:change""") 
End Sub 
Sub WriteLog (strMessage) 
Dim LogFile 
Dim fs 
Dim fsOut 
Logfile = Logpath & "AccountCreation.log" 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set fsOut = fs.OpenTextFile(LogFile, ForAppending, True) 
fsOut.WriteLine (strMessage) 
fsOut.Close 
End Sub 
Function DateToStr() 
DateToStr = DatePart("d",Now) & "/" & DatePart("m",Now) & "/" & DatePart("yyyy",Now) 
End Function 

' ## Reloads Page on pressing [Clear Form] ## 
Sub Reload 
Location.Reload(True) 
End Sub 

' ## Closes page on pressing [Exit] ## 
Sub CloseForm 
Window.Close 
End Sub 'CloseForm 

Sub About() 
On Error Resume Next 
strAbout="JBC User Account Creation Form v1.0" & VbCrLf 
strAbout= strAbout & "____________________________" & vbTab & VbCrLf & VbCrLf 
strAbout=strAbout & " User Creation Script" & VbCrLf & VbCrLf 
strAbout=strAbout & " Author: ???" & VbCrLf 
strAbout=strAbout & " Date:  " & vbcrlf & vbcrlf 
strAbout= strAbout & "____________________________" & VbCrLf & VbCrLf 
MsgBox strAbout,vbOKOnly+vbInformation,"About" 
End Sub 

Sub CreateAccount2()
	  If txtFirst.Value = "" Then 
			MsgBox "Please enter a first name.",64, "Alert" 
			Exit Sub
	  End If
	  If txtLast.Value = "" Then 
			MsgBox "Please enter a last name.",64, "Alert" 
			Exit Sub
	  End If 
	  If cbxDCServer.Value = "cbxDCServerAlert" Then 
			MsgBox "You must select a DC Server.",64, "Alert" 
			Exit Sub
	  End If
	  If cbxExchServer.Value = "cbxExchServerAlert" Then 
			MsgBox "You must select an Exchange Server.",64, "Alert" 
			Exit Sub
	  End If
	  If cbxStorageGrp.Value = "cbxStorageGrpAlert" Then 
			MsgBox "You must select a StorageGroup.",64, "Alert" 
			Exit Sub
	  End If
	  If cbxExch.Value = "cbxExchAlert" Then 
			MsgBox "You must select an Exchange Server.",64, "Alert" 
			Exit Sub
	  End If
	  If cbxMbxLanguage.Value = "cbxMbxLanguageAlert" Then 
			MsgBox "You must select a Mailbox Language.",64, "Alert" 
			Exit Sub
	  End If
	  strDCServerName = cbxDCServer.Value
	  strServerName = cbxExchServer.Value
	  strStorageGroup = cbxStorageGrp.Value
	  strMailboxStore = cbxExch.Value
	  strGivenName = txtFirst.Value
	  strSurname = txtLast.Value
	  strFolderLang = cbxMbxLanguage.Value
	  'Call AutomateMailboxCreation(strDCServerName, strServerName, strStorageGroup, strMailboxStore, strGivenName, strSurname, strFolderLang)
	  MsgBox "AutomateMailboxCreation(" & strDCServerName & ", " & strServerName & ", " & strStorageGroup & ", " & strMailboxStore & ", " & strGivenName & ", " & strSurname & ", " & strFolderLang & ")"
End Sub

</script> 
</head> 

<body bgcolor="#99CCFF"> 
<table border="0" width="717" height="156">
	<!-- MSTableType="layout" -->
	<tr>
		<td height="156" width="339"><p align="left"><u><b>Jarden Home Brands User Creation Script  V-1.0</b></u></p>
<p><b>NOTE:</b> Users initial password will be set to "<b>P@ssword</b>".</p>
		<p>Items marked with <font size="3" color="red"><b>*</b></font> are 
		required</p>
</td>
		<td height="156" width="362">
		</td>
	</tr>
</table>
<table width="710" border="0" cellspacing="0" CellSpacing="0"> 
<tr><td width="350" Valign="top"> 
<!-- LHS Of Main Table --> 
<table border="0" cellspacing="0" CellSpacing="0"> 
<tr><td width="350"> 
<!-- Username/Logon name --> 
<table border="0" cellspacing="0" CellSpacing="0" width="350"> 
<tr><td valign="top" colspan="3"><fieldset><legend><b>Username/Logon namee</b></legend> 
<table border="0" cellpadding="3" width="350"> 
<tr><td width="110"> <font size="3" color="red"><b>* </b></font> Logon name:</td><td><input type="text" 
name="txtUser" style="width:195px"></td><td> </td></tr> 
<tr><td> <font size="3" color="red"><b>* </b></font> First Name: </td><td><input type="text" name="txtFirst" style="width:195px"></td><td 
width="50"> </td></tr> 
<tr><td> <font size="3" color="red"><b>* </b></font> Last Name: </td><td><input type="text" name="txtLast" style="width:195px"></td><td> </td></tr> 
</table><p></fieldset></table> 
<!-- End of Username/Logon name --> 
<!-- User Account Properties --> 
<table border="0" cellpadding="0" cellspacing="0" width="350"> 
<tr><td valign="top" colspan="3"><fieldset><legend><b>User Account Properties</b></legend> 
<table border="0" cellpadding="3" width="350"> 
<tr> 
<td width="110">Job Title:</td><td><input type="text" name="txtTitle" style="width:195px"></td><td> </td> 
</tr> 
<tr><td>Office: </td> 
<td align="right"> 
	  <SPAN id="span_Office"></SPAN>
</td>
<td> </td> 
</tr> 
<tr> 
<td>Department: </td><td><input type="text" name="txtDepartment" style="width:195px"></td><td width="50"> </td> 
</tr> 
<tr> 
<td>Company: </td><td>
<input type="text" name="txtCompany" style="width:195px" size="1"></td><td> </td> 
</tr> 
<tr> 
<td>Manager: </td><td><input type="text" name="txtManager" style="width:195px"></td> 
</tr> 
</table><p></fieldset></table> 
<!-- End of User Account Properties --> 
<!-- Group Membership --> 
<table border="0" cellspacing="0" CellSpacing="0" width="350" height="51"> 
<tr> 
<td valign="top" colspan="3"> 
<input type="button" value=" About " onclick="About"> 
<input type="button" value="Clear Form" onclick="Reload" title=" Click to Clear Form "> 
<input type="button" value=" Submit " onClick="CreateAccount2" title=" Click to Create User Account "> 
<input type="button" value=" Exit " onclick="CloseForm" title=" Click to Exit Form "> 
</table> 
</td></tr></table> 

</td> 

<td width="350" Valign="top"> 
<!-- RHS Of Main Table --> 
<table border="0" cellspacing="0" CellSpacing="0"> 
<tr><td width="350"> 
<!-- Create User Mail Account --> 
<table border="0" cellspacing="0" CellSpacing="0" width="350"> 
<tr><td valign="top" colspan="3"><fieldset><legend><b>User Mail Account</b></legend> 
<table border="0" cellpadding="3" width="350"> 
<tr> 
<td width="300">Create user mailbox?</td><td width="50" align="middle"><input type="checkbox" name="chkExch"checked="False"disabled="False"></td> 
</tr></table> 
<table border="0" cellpadding="3" width="350"> 
<tr> 
<td width="125">
	  DC Server:
</td> 
<td align="right">
	  <SPAN ID='span_DCServer'></SPAN>
</td> 
</tr>
<tr> 
<td width="125">
	  Exchange Server:
</td> 
<td align="right">
	  <SPAN ID='span_ExchServer'></SPAN>
</td> 
</tr>
<tr> 
<td width="125">
	  Storage Group:
</td> 
<td align="right">
	  <SPAN ID='span_StorageGroup'></SPAN>
</td> 
</tr>
<tr> 
<td width="125">
	  Server/Mailstore:
</td> 
<td align="right">
	  <SPAN ID='span_cbxExch'></SPAN>
</td> 
</tr>
</table><p></fieldset></table> 
<!-- End of Create User Mailbox --> 
<!-- Create User Home Directory --> 
<table border="0" cellspacing="0" CellSpacing="0" width="350"> 
<tr><td valign="top" colspan="3"><fieldset><legend><b>User Home Directory</b></legend> 
<table border="0" cellpadding="3" width="350"> 
<tr> 
<td width="300">Create User Home Directory?</td><td width="50" align="middle"> 
<input type="checkbox" name="chkUserFolder" checked="false"> 
</td></tr> 
</table><p></fieldset></table> 
<!-- End Of Create User Home Directory --> 
</body> 
</html>


jswift17

jswift17

Posted
  • Author
Posted

ANyone have any ideas? I've continued to work on this, but I am bo NO MEANS a scripting guy. I'm struggling through as best I can, but could really use some help.

BUMP

  • 2 weeks later...
CoffeeFiend

CoffeeFiend

Posted
Posted (edited)
ANyone have any ideas? I've continued to work on this, but I am bo NO MEANS a scripting guy. I'm struggling through as best I can, but could really use some help.

I wish I could help there. It's actually a very simple job. But OpenLDAP went crazy and crashed on me during an upgrade last month... So I'd have to put up a AD server and configure it all, the join test workstations, create test users and all, just to get started on it :(

Ideally, it would be rewritten in JScript or such -- with proper error handling (including try/catch blocks -- and form validation too using Regular Expressions) instead of things like this i.e. when it can't connect to AD, it pops up WSH errors and asks to debug...

Again, very simple -- ADSI stuff is very straightforward (I could rewrite it all from scratch, in my sleep, in several languages), but quite time consuming (setup a testing AD box and all that, and then testing the script ran already logged in as a domain admin, or not as domain admin and then supplying different credentials after, etc. lots of testing to do)

It would be simple to add a section for plain old NT domains too, using javascript to set the relevant parts' .display properties (located on div's or span's) to block or none depending. You could even make it import people from csv/xml/json files and what not... And have a file for default config and such. And also a lot more features (exporting user infos, etc)...

Long story short, simple job, but so time consuming that you're likely not gonna get much help for it. Not sure how much of a rush you're in but if you can wait, then I'll probably get around to it eventually...

We just administer it with the standard tools, and some scripts much like useradd.vbs

Edit: well, the hta is also for mailboxes, sorry, but I'm just not putting up a test exchange box for that :(

Edited by crahak

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share
Go to topic listing

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...