Link to home
Start Free TrialLog in
Avatar of cholmskov
cholmskov

asked on

VBS Script Create AD Account & HomeDrive

Hello again EE, another question for you all.

This time it's a bit more tricky.

I need a MakeUser script that creates a user in AD, in the correct OU, sets settings including password and login scripts, then creates a Home drive on a server with correct permissions.

The home-drive is not as vital as the create-user part.

So here is the requirement.

Create a User in a specific OU that could be domain.name.com -> country -> department -> subdepartment -> user dir
Sets the users First Name
Sets the users Last Name
Sets the users Login Name
Sets the users Display name
Sets the users default LoginScript
Sets the users default password

OU's are defined by 3 things
Region
Country
Department

What I would like is a series of input boxes that query for the users First Name, Last Name, LoginName, Country and Department, then uses the answers for this to place the users in the correct AD, using First Name and Last Name as the DisplayName.
The Login Script and Default paswords are static and so does not require a query

The other part that is a "Nice to Have" is this.

I would like to know the base code for creating a folder and setting permissions, but as I said this is not vital.



ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Oh, you'll also see this section:
            ' ** SET THIS TO TRUE TO CREATE A SHARE ON THE NEW USER FOLER
            ' ** IF YOU ALREADY HAVE A SHARE ON THE PARENT FOLDER, THIS IS PROBABLY NOT REQUIRED
            bCreateNewShare = False


what that can do, is create a new share *on* the new user's home drive, so you could use
\\server\jsmith

instead of
\\server\users$\jsmith

but that's probably more messy, so try to do without it.....

Regards,

Rob.
Avatar of cholmskov
cholmskov

ASKER

Wow, that is one damn nice solution! :D

Thanks a ton Rob, it works like a charm!!!!

Now to spend the next few weeks understanding what you did :)

Amazing solution, best I have seen so far and it's very well described so one can learn from it, Thanks once again Rob! :)
Thanks!  It does work quite well, and I'm happy that I finally put it together!

It took me the longest to work out the domain's OU enumeration to represent that in a list box, but it's cool!
I eventually want to extend it to be able to create the user on the chosen site's domain controller, so that it can be used straight away at that site, rather than having to wait for AD replication.....but that's another project....

Regards,

Rob.
A question, how do I make one of these but for the AD im not using myself ??

Like in the last script, we are working with 2 different ad's, soon possibly 3 of them.

I don't mind having to use 2 seperate scripts, but I need to be able to make one for the other domain as well
Hi, good question, and hey, that gives me an idea on how to change domain controllers, so woohoo!

Here, you go.....same as before, but this time you can change:

            strShare = "\\server\users$\"
            strLoginScript = "Script1.bat"
            strPassword = "d3f@ultP@55"
            arrDomains = Array( _
                  "dc1/DC=domain1,DC=com", _
                  "dc2/DC=domain2,DC=com" _
                  )



Regards,

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

Open in new window

Excellent :D
Humm the script crashes for me when I choose the other AD, it just stands frozen with the Dropdown menu shown and my selection, can't click anything and the box don't vanish again :(
Also the Site Filer died, even for the standard AD that does work, it's just empty  now
Rob you still around ?
Yeah, sorry, I am still here....just been quite busy over the last couple of days....

Hmmm.....so.....this has worked for me connecting to different DCs, so all I can suggest is that in this section:
            arrDomains = Array( _
                  "dc1/DC=domain1,DC=com", _
                  "dc2/DC=domain2,DC=com" _
                  )

you just make sure that you've specified an exact name for the domain controller, and make sure you use a forward slash, and not a backward slash, after that name, then have your domain components specified correctly by the DC bits.

It should work if you have it the same as you did in the other VBS script we used the other day....

Regards,

Rob.
Actually, there were a couple of issues there relating to creating the user in the correct domain controller, which I have now fixed.

Again, modify your arrDomains to suit, and see how this goes.

Regards,

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

Open in new window

Well this was an improvement, but I get an error 50008000 this time, but I have checked the spelling and it is correct.

arrDomains = Array( _
"dks022/DC=nordic,DC=bayer,DC=cnb", _
"hdelevdc001/DC=emea,DC=,healthcare,DC=cnb" _
)

Also it complains that it's line 54 but thats
strBaseConnString = lstDomains.Value

I should mention that I now see both domains and that the top domain works perfect like before.
It's when I change to the 2'nd it fails.

I have tried 3 different domain controllers for the 2'nd domain and so far they all give the same.
Im trying to seperate the two domains now and just enter 1, and it still "freezes" when I use the 2'nd one, so im assuming there is something wrong with it.