HTA Script for Mapping Network Drives

I had a need for a user friendly Windows script to map network drives using credentials supplied by the user.  The script I endend up with is an HTA script that allows the user to enter their credentials and map a predefined set of network drives.  There is also a button to disconnect the mapped drives.

The script is here :

<!-- HTA script to allow machines that are not joined to a domain to access
     Windows file shares with domain credentials. It will atomatically prepend the
     domain to the username and then map several drives. If a drive is already
     mapped, it is disconnected and then mapped for the current user.
     Version 1.0.2
     Written by Vaughn Miller 7/20/2012
     Currently setup to map the following drives :
     M: = \\\dept
     O: = \\\users
     W: = \\mcweb\messiahweb

<TITLE>Connect Network Drives</title>


' *** Define Drive Mappings ***
dim arrDrives(2,2)
intMaxdrives = 2

arrDrives(0,0) = "M:"
arrDrives(0,1) = "\\\dept"
arrDrives(0,2) = "Dept"

arrDrives(1,0) = "O:"
arrDrives(1,1) = "\\\users"
arrDrives(1,2) = "Users"

arrDrives(2,0) = "W:"
arrDrives(2,1) = "\\mcweb\messiahweb"
arrDrives(2,2) = "messiahweb"
' *** End Drive Map Definitions ***

strDOMAIN = "messiah\" 'Domain to prepend to the username

Sub Window_Onload
  '# Size Window
  sHorizontal = 440
  sVertical = 175
  Window.resizeTo sHorizontal, sVertical
  '# Get Monitor Details
  Set objWMIService = GetObject _
  intHorizontal = sHorizontal *2
  intVertical = sVertical *2
  Set colItems = objWMIService.ExecQuery( _
    "Select ScreenWidth, ScreenHeight from" _
    & " Win32_DesktopMonitor", , 48)
  For Each objItem In colItems
    sWidth= objItem.ScreenWidth
    sHeight = objItem.ScreenHeight
    If sWidth > sHorizontal _
      then intHorizontal = sWidth
    If sHeight > sVertical _
      then intVertical = sHeight
  Set objWMIService = Nothing
  '# Center window on the screen
  intLeft = (intHorizontal - sHorizontal) /2
  intTop = (intVertical - sVertical) /2
  Window.moveTo intLeft, intTop
  '# default window content
End Sub

Sub RunScript
   on Error Resume Next

   minUSRnamelength = 2
   minPASSwrdlength = 3

   strUsr = UsrnameArea.Value
   strPas = PasswordArea.Value

   Set objNetwork = CreateObject("WScript.Network")
   Set oShell = CreateObject("Shell.Application")

   If Len(strUsr) >= minUSRnamelength then
      strUsr = strDOMAIN & UCase(strUsr) '<--- adds the domain before the username

      if Len(strPas) >= minPASSwrdlength Then
         Call ClearDrives ' Delete existing mappings if they exist
         '***** Begin Drive mapping *****
         For n = 0 To intMaxDrives 'Loop through our array of drives
            objNetwork.MapNetworkDrive arrDrives(n,0), arrDrives(n,1), False, strUsr, strPas
            If Err.Number = 0 Then
               oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
            End If
         '***** End Drive Mapping *****
            Msgbox chr(34) & strPas & """ is an incorrect password !"
            Exit Sub
         End If
      Msgbox chr(34) & strUsr & """ is an incorrect Username !"
      Exit Sub
   End If
    ' Clean up the objects before exiting
   Set oShell = Nothing
   Set objNetwork = Nothing
End Sub

Sub ClearDrives ' Sub Routine to remove the drives if they are already mapped
  On Error Resume Next
  Set objNetwork = CreateObject("WScript.Network")

  '***** Begin section to delete drive mappings ***
  Set AllDrives = objNetwork.EnumNetworkDrives
  For n = 0 To intMaxDrives 'Loop through our array of drives
     For i = 0 To AllDrives.Count - 1 Step 2
        If AllDrives.Item(i) = arrDrives(n,0) Then AlreadyConnected = True
     If AlreadyConnected = True then
        objNetwork.RemoveNetworkDrive arrDrives(n,0), True, True
     End If
  '***** End section to delete drive mappings
End Sub

Sub DisconnectDrives ' Calls ClearDrives subroutine and then closes the window
Call ClearDrives
    Set oShell = Nothing
    Set objNetwork = Nothing
End Sub

Sub CancelScript
   Set oShell = Nothing
   Set objNetwork = Nothing
End Sub


<BODY STYLE="font:14 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
<a name="Top"></a><CENTER>
  <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
      <td height="30">
        <p align="right">Your Username</p>
      <td height="30">&nbsp;&nbsp; <input type="text" name="UsrnameArea" size="30"></td></tr>
      <td height="30">
        <p align="right">Password</p>
      <td height="30">&nbsp;&nbsp; <input type="password" name="PasswordArea" size="30"></td></tr>
<HR color="#0000FF">
 <Input id=runbutton class="button" type="button" value=" Map Drives " name="run_button" onClick="RunScript">
 <Input id=runbutton class="button" type="button" value=" Disconnect Drives " name="dis_button" onClick="DisconnectDrives">
 <Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button" onClick="CancelScript">


The drive definitions are coded in an array so that the mapping and disconnecting subroutines can use a loop. To modify this for your own use, you need to modify strDomain (line 50) and the drive definitions (lines 33-48).

I think a nice revision of this script would be to design it to read a configuration file for the domain info and drive definitions. This was one motivation for implementing the array/loop structure.

One thought on “HTA Script for Mapping Network Drives

Leave a Reply

Your email address will not be published. Required fields are marked *