Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

Help with persistent drive mappings in .vbs script

Avatar of csandlin
csandlin asked on
Scripting LanguagesVB Script
1 Comment1 Solution745 ViewsLast Modified:

I have inherited a login script that maps network drives for the users. How can I make the drive mappings persistent upon reboot (for VPN access, etc). Script attached.

' Login.vbs
' VBScript logon script program.
' ----------------------------------------------------------------------
Option Explicit

Dim objNetwork, objSysInfo, strUserDN
Dim objGroupList, objUser, objFSO, ObjShell,UserName
Dim strComputerDN, objComputer, objItem, shell
Set Shell = WScript.CreateObject("WScript.Shell")
UserName = Shell.ExpandEnvironmentStrings("%USERNAME%")

Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.userName
strComputerDN = objSysInfo.computerName

' Bind to the user and computer objects with the LDAP provider.
Set objUser = GetObject("LDAP://" & strUserDN)
Set objComputer = GetObject("LDAP://" & strComputerDN)

'-------------Maps the Share Drive to F -------------------------
	if Not MapDrive("F:", "\\public\share") Then
   MsgBox "Unable to Map F: to Public"
End If

'-------------Maps the Users Drive to H -------------------------
	if Not MapDrive("H:", "\\nas\privatedata\" & username) Then
   MsgBox "Unable to Map H: to Privatedata"
End If

'--------------Maps the Users Drive to H-------------------------

'If IsMember(objUser, "Domain Users") Then
'	if Not MapDrive("H:", "\\data\privatedata\" & Username) Then
'   MsgBox "Unable to Map H: to User Private Share"
'End If
'End If

' Clean up.
Set objNetwork = Nothing
Set objFSO = Nothing
Set objSysInfo = Nothing
Set objGroupList = Nothing
Set objUser = Nothing
Set objComputer = Nothing

Function IsMember(objADObject, strGroup)
' Function to test for group membership.
' objGroupList is a dictionary object with global scope.

  If IsEmpty(objGroupList) Then
    Set objGroupList = CreateObject("Scripting.Dictionary")
  End If
  If Not objGroupList.Exists(objADObject.sAMAccountName & "\") Then
    Call LoadGroups(objADObject, objADObject)
    objGroupList(objADObject.sAMAccountName & "\") = True
  End If
  IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
    & strGroup)
End Function

Sub LoadGroups(objPriObject, objADSubObject)
' Recursive subroutine to populate dictionary object objGroupList.

  Dim colstrGroups, objGroup, j

  objGroupList.CompareMode = vbTextCompare
  colstrGroups = objADSubObject.memberOf
  If IsEmpty(colstrGroups) Then
    Exit Sub
  End If
  If TypeName(colstrGroups) = "String" Then
    Set objGroup = GetObject("LDAP://" & colstrGroups)
    If Not objGroupList.Exists(objPriObject.sAMAccountName & "\" _
        & objGroup.sAMAccountName) Then
      objGroupList(objPriObject.sAMAccountName & "\" _
        & objGroup.sAMAccountName) = True
      Call LoadGroups(objPriObject, objGroup)
    End If
    Set objGroup = Nothing
    Exit Sub
  End If
  For j = 0 To UBound(colstrGroups)
    Set objGroup = GetObject("LDAP://" & colstrGroups(j))
    If Not objGroupList.Exists(objPriObject.sAMAccountName & "\" _
        & objGroup.sAMAccountName) Then
      objGroupList(objPriObject.sAMAccountName & "\" _
        & objGroup.sAMAccountName) = True
      Call LoadGroups(objPriObject, objGroup)
    End If
  Set objGroup = Nothing
End Sub

Function MapDrive(strDrive, strShare)
' Function to map network share to a drive letter.
' If the drive letter specified is already in use, the function
' attempts to remove the network connection.
' objFSO is the File System Object, with global scope.
' objNetwork is the Network object, with global scope.
' Returns True if drive mapped, False otherwise.

  Dim objDrive

  On Error Resume Next
  If objFSO.DriveExists(strDrive) Then
    Set objDrive = objFSO.GetDrive(strDrive)
    If Err.Number <> 0 Then
      On Error GoTo 0
      MapDrive = False
      Exit Function
    End If
    If CBool(objDrive.DriveType = 3) Then
      objNetwork.RemoveNetworkDrive strDrive, True, True
      MapDrive = False
      Exit Function
    End If
    Set objDrive = Nothing
  End If
  objNetwork.MapNetworkDrive strDrive, strShare
  If Err.Number = 0 Then
    MapDrive = True
    MapDrive = False
  End If
  On Error GoTo 0
End Function
Avatar of exx1976
exx1976Flag of United States of America image

Our community of experts have been thoroughly vetted for their expertise and industry experience.

This problem has been solved!
Unlock 1 Answer and 1 Comment.
See Answers