VBScript - Map drives over VPN

I've been playing with the following code I found on the Internet.  The script will prompt for your AD credentials and map drives based on groups.

<title>Drive Mapper</title>
     APPLICATIONNAME="Drive Mapper"

body {
td,input	{
a	{

	<td>Enter your username?<br/></td>
	<td><input type="text" id="txt_Username" name="txt_Username" /></td>
	<td>What is your password?</td>
	<td><input type="password" id="txt_Password" name="txt_Password" /></td>
	<td colspan="2">&nbsp;</td>
	<td colspan="2" align="center"><input type="button" value="Configure Resources" id="btn_Configure" /></td>


Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Sub Window_OnLoad
	Dim X, Y, strComputer, objWMIService, colItems, objItem, intHorizontal, strYear
	window.resizeTo X,Y
		' resize the HTA
	strComputer = "."
	Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
	For Each objItem in colItems
		intHorizontal = objItem.ScreenWidth
		intVertical = objItem.ScreenHeight
	window.moveTo (intHorizontal - X) / 2, (intVertical - Y) / 2
		' centre it
End Sub

Sub btn_Configure_OnClick

	If txt_Username.value="" Then
		MsgBox "Please enter your name",16,"ERROR"
		Exit Sub
	End If
	If txt_Password.value="" Then
		MsgBox "Please enter your password",16,"ERROR"
		Exit Sub
	End If
	' This will call the GetGroupMembership sub which will in turn call the MapDriveByGroup sub
' Configure your global resources here - they will be connected for every user
'	MapDrive "Z:","\\Server\User Storage\Pupils\" & lisYear.value & "\" & txtName
'	MapDrive "T:","\\Server\student shared$"
	MsgBox "Network resources have been configured",64,"DONE"
End Sub

Sub MapDrive(DriveLetter,DrivePath)
	If objFSO.DriveExists(DriveLetter) Then
		objNetwork.RemoveNetworkDrive DriveLetter, True
	End If
	objNetwork.MapNetworkDrive DriveLetter, DrivePath, False, txt_Username.value, txt_Password.value
End Sub

'Sub MapDriveByGroup(sGroupName)
'	Select Case LCase(sGroupName)
'		Case LCase("TechTeam")
'		MapDrive "X:", "\\lan.peddie.org\tech$", "Technology"
'	End Select
'End Sub

Sub MapDriveByGroup(strGroupName)
	Select Case LCase(strGroupName)
		Case LCase("TechTeam")
			MapDrive "x:", "\\lan.peddie.org\tech$"
	End Select
End Sub

Sub GetGroupMembership

	Const ADS_SERVER_BIND = &H200
	' Specify a server (Domain Controller).
	strServer = "DC01.my.domain"
	' Specify or prompt for credentials.
	strUser = txt_username.value
	strPassword = txt_password.value
	' Determine DNS domain name. Use server binding and alternate
	' credentials. The value of strDNSDomain can also be hard coded.
	Set objNS = GetObject("LDAP:")
	On Error Resume Next
	Set objRootDSE = objNS.OpenDSObject("LDAP://" & strServer & "/RootDSE", strUser, strPassword, ADS_SERVER_BIND Or ADS_SECURE_AUTHENTICATION)
	If Err.Number = 0 Then
		strDNSDomain = objRootDSE.Get("defaultNamingContext")
		' Use ADO to search Active Directory.
		' Use alternate credentials.
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Properties("User ID") = strUser
		adoConnection.Properties("Password") = strPassword
		adoConnection.Properties("Encrypt Password") = True
		adoConnection.Open "Active Directory Provider"
		Set adoCommand.ActiveConnection = adoConnection
		' Search entire domain. Use server binding.
		strBase = "<LDAP://" & strServer & "/" & strDNSDomain & ">"
		' Search for all users.
		strFilter = "(&(objectCategory=person)(objectClass=user)(samAccountName=" & strUser & "))"
		' Comma delimited list of attribute values to retrieve.
		strAttributes = "distinguishedName"
		' Construct the LDAP query.
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		' Run the query.
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 30
		adoCommand.Properties("Cache Results") = False
		Set adoRecordset = adoCommand.Execute
		' Enumerate the resulting recordset.
		strDN = ""
		Do Until adoRecordset.EOF
		     ' Retrieve values.
		     strDN = adoRecordset.Fields("distinguishedName").Value
		If strDN = "" Then
			MsgBox "User " & strUser & " was not found."
			Set objUser = GetObject("LDAP://" & strDN)
			MsgBox objUser
			' This line will map the home drive of the user
			MapDrive objUser.HomeDrive, objUser.HomeDirectory
			' Now we will map the other drives by group membership
			If TypeName(objUser.MemberOf) = "Empty" Then
				MsgBox "You are not a member of any groups."
			ElseIf TypeName(objUser.MemberOf) = "String" Then
				strGroupName = Mid(Split(objUser.MemberOf, ",")(0), 4)
				MapDriveByGroup strGroupName
				For Each strGroup In objUser.MemberOf       'Walk through the groups that user is a member of
					strGroupName = Mid(Split(strGroup, ",")(0), 4)              'Get the group name
					MapDriveByGroup strGroupName
			End If

		End If
		MsgBox "Connection failure.  Wrong password?"
	End If
	On Error GoTo 0
End Sub

Sub DeletePersistentMappings
  On Error Resume Next

DIM objNetwork,colDrives,i

Set objNetwork = CreateObject("Wscript.Network")

Set colDrives = objNetwork.EnumNetworkDrives

For i = 0 to colDrives.Count-1 Step 2
	' Force Removal of network drive and remove from user profile 
	' objNetwork.RemoveNetworkDrive strName, [bForce], [bUpdateProfile]
	objNetwork.RemoveNetworkDrive colDrives.Item(i),TRUE,TRUE
End Sub 

Sub RenameBackupDrive
  If objFSO.DriveExists("U:") = True Then          
    objShell.NameSpace("U:").Self.Name = UserName & "'s Drive"
  End If
End Sub


Open in new window

It's not clean but the functionality works fine whilst on the domain. When I try to tun the script through a VPN connection, the script fails. I'm on a non-domain computer when running the script. It returns the error that I'm not a member of any groups.  Under line 178 I placed a msgbox for objUser and it returns empty.

Set objUser = GetObject ("LDAP://" & strDN)
MsgBox objUser

I need help with the following:
1. Resolve the issue of the script no enumerating the groups for the user specified. (remember: this works fine when on the domain. Not working over a VPN connection on a non-domain computer).
2. I would like to add nested groups to search as well.

Any help would be greatly appreciated.

LVL 22
Ivano ViolaSystem AdministratorAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

omgangIT ManagerCommented:
Just a quick look but I think this is the issue.

Lines 125-126
      ' Specify or prompt for credentials.
      strUser = txt_username.value

but up on line 66

The script is retrieving the username from the local workstation which isn't joined to the domain.  You need to change that to have the user enter the domain user credential into the text box.
See if that resolves the problem.

OM Gang
Ivano ViolaSystem AdministratorAuthor Commented:

Sorry about that. Yes it was pulling the local username but I was overwriting it with my domain account when testing remotely.  

omgangIT ManagerCommented:
Suggest you comment out line 132
On Error Resume Next

This should allow you to see where an error is occurring and troubleshoot from there.
OM Gang
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Ivano ViolaSystem AdministratorAuthor Commented:
MsgBox "Connection failure.  Wrong password?"

Line 198

I guess it has issues connecting and querying AD when over VPN. I assume it's DNS? DO I need to add an entry in the hosts file or is it code?
omgangIT ManagerCommented:
Lines 133 - 134
      Set objRootDSE = objNS.OpenDSObject("LDAP://" & strServer & "/RootDSE", strUser, strPassword, ADS_SERVER_BIND Or ADS_SECURE_AUTHENTICATION)
      If Err.Number = 0 Then

Lines 197-198
            MsgBox "Connection failure.  Wrong password?"

So, here's what's happening:  an error is occurring on line 133.  The next line of code evaluates current error code in stack and says "If the error equals zero (meaning no error at all) then proceed"
There is an error so none of the code block within the If...Else statements gets executed.  Instead the code jumps to line 198 which is your messagebox command.

Best guess is the code if failing on line 131
Set objNS = GetObject("LDAP:")

Let me do some checking, or you can do some checking (i.e. Googling) on performing LDAP over VPN.
OM Gang
omgangIT ManagerCommented:
Looks like I am probably incorrect on the error being with line 131.  See this PAQ which is very pertinent to your Q
It gives example of binding to remote directory via vbscript
OM Gang

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Ivano ViolaSystem AdministratorAuthor Commented:

The link you provided me put me in the right direction. I don't have nested groups working at the moment but I'll work on that.

Thanks for you help.

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.