'*****
'*** 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 = "sys1\user"
UserDirectoriesPath = "e:\sys1\user"
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 & "\sys1\User\" & 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 & "\sys1\User\" & 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 & "\root\cimv2")

'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

<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 = "\\Server2\netlogon\psexec.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 = "\sys1\user\"
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 & "\sys1\users")
' ## Create users home folder ##
If objFSO.FolderExists("\\" & strUserServer & "\sys1\users" & strUser) = False Then
objFSO.CreateFolder("\\" & strUserServer & "\sys1\users" & LCase(strUser))
End If

' ## Assign user change NTFS permissions on home drives ##
Set objShell = CreateObject("Wscript.Shell")
strUserFolder = "\\" & strUserServer & "\sys1\users" & 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&nbsp; V-1.0</b></u></p>
<p><b>NOTE:</b> Users initial password will be set to &quot;<b>P@ssword</b>&quot;.</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>&nbsp;</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">&nbsp;</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>&nbsp;</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>&nbsp;</td>
</tr>
<tr><td>Office: </td>
<td align="right">
<SPAN id="span_Office"></SPAN>
</td>
<td>&nbsp;</td>
</tr>
<tr>
<td>Department: </td><td><input type="text" name="txtDepartment" style="width:195px"></td><td width="50">&nbsp;</td>
</tr>
<tr>
<td>Company: </td><td>
<input type="text" name="txtCompany" style="width:195px" size="1"></td><td>&nbsp;</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>