jswift17

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

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 ). 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>