Announcement

Collapse
No announcement yet.

HTA/VBS Script To Map Network Drives

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • HTA/VBS Script To Map Network Drives

    Hi all! This is my first post on this site, and I am very new to VBS and HTA, so please bear with me. I need to perform the following:

    I need a script (VBS) with a graphical interface (HTA) that allows my end users to input their Active Directory username and password. That information is then used to authenticate the procedure. The username information is then also used as part of the file path for one of the drives. See BLUE AREAS.

    Additionally, if things weren't difficult enough already, our users work in multiple departments, which then receive file shares based upon those departments. I need to be able to pull values from a drop down list in the HTA code and dump them into another file path. See RED AREAS.

    HELP ME PLEASE!!! I've been fighting this for days!


    ------------------------------------------------------------------------
    Code:
    <HTML>
    <HEAD>
    <TITLE>Universal Network Drives</title>
    <HTA:APPLICATION
    ICON="designer.ico"
         ApplicationName="MapDrives.HTA"
         SingleInstance="Yes"
         WindowsState="Normal"
         Scroll="No"
         Navigable="Yes"
         MaximizeButton="No"
         SysMenu="Yes"
         Caption="Yes"
    ></HEAD>
    
    <SCRIPT LANGUAGE="VBScript">
    
    ' <-- ************ Define Drive Mappings ************
    
    dim arrDrives(2,2)
    intMaxdrives = 2
    
    arrDrives(0,0) = "K:"
    arrDrives(0,1) = "\\172.20.1.6\Shared"
    arrDrives(0,2) = "Shared"
    
    arrDrives(1,0) = "I:"
    arrDrives(1,1) = "\\cpfs-cfs.skynet.local\Departments-Staff\%DEPARTMENT%"
    arrDrives(1,2) = "Department"
    
    arrDrives(2,0) = "P:"
    arrDrives(2,1) = "\\cpfs.skynet.local\Home\%USERNAME%"
    arrDrives(2,2) = "My Documents"
    
    ' <-- ************ End Drive Map Definitions ************
    
    strDOMAIN = "skynet\" ' <--- ************ Domain to prepend to the username ************
    
    
    Sub Window_Onload
      ' <-- ************ # Size Window ************
      sHorizontal = 440
      sVertical = 220
      Window.resizeTo sHorizontal, sVertical
      ' <-- ************ # Get Monitor Details ************
      Set objWMIService = GetObject _
        ("winmgmts:root\cimv2")
      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
      Next
      Set objWMIService = Nothing
      ' <-- ************ # Center window on the screen ************
      intLeft = (intHorizontal - sHorizontal) /2
      intTop = (intVertical - sVertical) /2
      Window.moveTo intLeft, intTop
      ' <-- ************ # default window content ************
      window.location.href="#Top"
    End Sub
    
    
    Sub RunScript
    on Error Resume Next
    
       minUSRnamelength = 3
       minPASSwrdlength = 4
    
       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) '<--- ************ Prepends the domain to 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 ************
                Err.Clear
                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
             Next
             ' ************ End Drive Mapping ************
              
             ELSE
                Msgbox chr(34) & strPas & """ is an incorrect password !"
                Exit Sub
             End If
       ELSE
          Msgbox chr(34) & strUsr & """ is an incorrect Username !"
          Exit Sub
       End If
        ' <-- ************ Clean up the objects before exiting ************
       Set oShell = Nothing
       Set objNetwork = Nothing
       Self.Close()
    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
         Next
         If AlreadyConnected = True then
            objNetwork.RemoveNetworkDrive arrDrives(n,0), True, True
         End If
      Next
      ' <-- ************ 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
    Self.close()
    End Sub
    
    
    Sub CancelScript
       Set oShell = Nothing
       Set objNetwork = Nothing
       Self.Close()
    End Sub
    
    </SCRIPT>
    
    
    <BODY STYLE="font:14 pt arial; color:000000; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#7d8c40', EndColorStr='#7d8c40')">
    <a name="Top"></a><CENTER>
      <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
        <select size="1" name="OptionChooser" align="right">
        <option value="0">Please Choose A Department</option>
        <option value="DEPT1">DEPARTMENT 1</option>
        <option value="DEPT2">DEPARTMENT 2</option>
      </select>
        <tr>
          <td height="30">
            <p align="right">Username</p>
          </td>
          <td height="30">&nbsp;&nbsp; <input type="text" name="UsrnameArea" size="30"></td></tr>
        <tr>
          <td height="30">
            <p align="right">Password</p>
          </td>
          <td height="30">&nbsp;&nbsp; <input type="password" name="PasswordArea" size="30"></td></tr>
      </table><BR>
    <HR color="#000000">
     <Input id=runbutton class="button" type="button" value=" Map Drives " name="run_button" onClick="RunScript">
        &nbsp;
     <Input id=runbutton class="button" type="button" value=" Disconnect Drives " name="dis_button" onClick="DisconnectDrives">
        &nbsp;
     <Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button" onClick="CancelScript">
     <p>
     <table align="center">
     MapDrives v1.0.0 
     </table>
    </CENTER>
    </BODY>
    
    </HTML>
    ------------------------------------------------------------------------
    Last edited by Dumber; 21st November 2012, 10:04.

  • #2
    Re: HTA/VBS Script To Map Network Drives

    Help me Obi-Wan Kenobies...you're my only hope!!!

    Comment


    • #3
      Re: HTA/VBS Script To Map Network Drives

      I can't help with the script I'm afraid but I do have to ask if you really need this?
      Not aware of your setup but if you're all plugged into AD then you can use group policy to map drives based on group membership.
      cheers
      Andy

      Please read this before you post:


      Quis custodiet ipsos custodes?

      Comment


      • #4
        Re: HTA/VBS Script To Map Network Drives

        Wrapped code tags for ease of readability.
        Marcel
        Technical Consultant
        Netherlands
        http://www.phetios.com
        http://blog.nessus.nl

        MCITP(EA, SA), MCSA/E 2003:Security, CCNA, SNAF, DCUCI, CCSA/E/E+ (R60), VCP4/5, NCDA, NCIE - SAN, NCIE - BR, EMCPE
        "No matter how secure, there is always the human factor."

        "Enjoy life today, tomorrow may never come."
        "If you're going through hell, keep going. ~Winston Churchill"

        Comment


        • #5
          Re: HTA/VBS Script To Map Network Drives

          @AndyJG247 - This script is for use on non-domain joined machines. We can't use GPO in this case.

          @Dumber - Thank you for wrapping that! I didn't know what the tags were.

          Comment


          • #6
            Re: HTA/VBS Script To Map Network Drives

            Based on the script MapDrives.hta version 1.0.2 written by Vaughn Miller
            https://github.com/vmiller/ConnectDr.../MapDrives.hta

            Code:
            <HTML>
            
              [... cut ...]  
            
            ' <-- ************ Define Drive Mappings ************
            
            dim arrDrives(2,2)
            intMaxdrives = 2
            
            arrDrives(0,0) = "K:"
            arrDrives(0,1) = "\\172.20.1.6\Shared"
            arrDrives(0,2) = "Shared"
            
            arrDrives(1,0) = "I:"
            arrDrives(1,1) = "\\cpfs-cfs.skynet.local\Departments-Staff\$DEPT"
            arrDrives(1,2) = "Department"
            
            arrDrives(2,0) = "P:"
            arrDrives(2,1) = "\\cpfs.skynet.local\Home\$USR"
            arrDrives(2,2) = "My Documents"
            
            ' <-- ************ End Drive Map Definitions ************
            
            strDOMAIN = "skynet\" ' <--- ************ Domain to prepend to the username ************
            
              [... cut ...]  
            
            Sub RunScript
               on Error Resume Next
            
               strUsr = Trim(UsrnameArea.Value)
               strPas = Trim(PasswordArea.Value)
               strDept = OptionChooser.value
            
               minUSRnamelength = 3
               minPASSwrdlength = 4
            
               msg = vbNewline
               br = vbNewline & vbNewline
            
               If Len(strDept) = 1 Then _
                   msg = msg & "* please select your department!" & br
               If Len(strUsr) < minUSRnamelength Then _
                   msg = msg & "* incorrect username!" & br
               If Len(strPas) < minPASSwrdlength Then _
                   msg = msg & "* invalid password!" & br
               If Len(msg) > 2 Then MsgBox msg, 64, "Notes" : Exit Sub
            
               If instr(1,strUsr,strDOMAIN,1) < 1 Then
                   strAcc = UCase(strDOMAIN & strUsr) '<--- ************ Prepends the domain to the username ************
               Else
                   strAcc = UCase(strUsr)
               End If
            
               Set objNetwork = CreateObject("WScript.Network")
               Set oShell = CreateObject("Shell.Application")
            
               Call ClearDrives ' Delete existing mappings if they exist
            
               ' <-- ************ Begin Drive mapping ************
               For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
                 strPath = arrDrives(n,1)
                 strPath = Replace(strPath, "$USR", strUsr, 1, -1, 1)
                 strPath = Replace(strPath, "$DEPT", strDept, 1, -1, 1)
            
            'check.....
                 msgbox  "Drive" & vbTab & ": " & arrDrives(n,0) & vbnewline _
                       & "Path" & vbTab & ": " & strPath & vbnewline _
                       & "Account" & vbTab & ": " & strAcc & vbnewline _
                       & "Password" & vbTab & ": " & strPas
            
                 Err.Clear
                 objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
                 If Err.Number = 0 Then
                   oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
                 End If
            
               Next
               ' ************ End Drive Mapping ************
            
               ' <-- ************ Clean up the objects before exiting ************
               Set oShell = Nothing
               Set objNetwork = Nothing
               Self.Close()
            End Sub
            
              [... cut ...]  
            
            </HTML>
            /Rems

            This posting is provided "AS IS" with no warranties, and confers no rights.

            __________________

            ** Remember to give credit where credit's due **
            and leave Reputation Points for meaningful posts

            Comment


            • #7
              Re: HTA/VBS Script To Map Network Drives

              I'd also like to add that you bumped a post 2 mins after posting your original post. We do not like that sort of thing here.

              Everyone of us gives up our free time to come and help people like you who are having issues and as such there is not always someone around to answer your question.

              Please refrain from bumping yoour posts in the future.

              I'd also like to mention the bold red font on your second post. This again isn't really the way to get your question answered. Please refrain from doing so again and it may be worthwhile re-reading the forums rules.

              Comment


              • #8
                Re: HTA/VBS Script To Map Network Drives

                I am yet again in need of some assistance with this .hta file. In an effort to add some complexity to it, I broke something. I have since added some javascript that controls the selection menus. However, my current problem is that when any username/password is entered they "invalid username/password error" is generated. I can't seem to figure out how to fix it. Help? Ideas?

                --------------------------------------------------------------------
                Code:
                <HTML>
                <HEAD>
                <TITLE> myDrives - WWU Network Drive Tool</title>
                <HTA:APPLICATION
                ICON="designer.ico"
                     ApplicationName="myDrives.HTA"
                     SingleInstance="Yes"
                     WindowsState="Normal"
                     Scroll="No"
                     Navigable="Yes"
                     MaximizeButton="No"
                     SysMenu="Yes"
                     Caption="Yes"
                ></HEAD>
                
                <SCRIPT LANGUAGE="VBScript">
                
                '<--- ************ Define Drive Mappings ************
                dim arrDrives(2,2)
                intMaxdrives = 2
                
                arrDrives(0,0) = "K:"
                arrDrives(0,1) = "\\172.20.1.6\Shared"
                arrDrives(0,2) = "Shared"
                
                arrDrives(1,0) = "I:"
                arrDrives(1,1) = "\\cpfs-cfs.skynet.local\Departments-Staff\$DEPT"
                arrDrives(1,2) = "Department"
                
                arrDrives(2,0) = "P:"
                arrDrives(2,1) = "\\cpfs.skynet.local\Home\$USR"
                arrDrives(2,2) = "My Documents"
                
                '<--- ************ Domain to prepend to the username ************
                strDOMAIN = "skynet\"
                
                
                Sub Window_Onload
                  '# Size Window
                  sHorizontal = 440
                  sVertical = 280
                  Window.resizeTo sHorizontal, sVertical
                  '# Get Monitor Details
                  Set objWMIService = GetObject _
                    ("winmgmts:root\cimv2")
                  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
                  Next
                  Set objWMIService = Nothing
                  '# Center window on the screen
                  intLeft = (intHorizontal - sHorizontal) /2
                  intTop = (intVertical - sVertical) /2
                  Window.moveTo intLeft, intTop
                  '# default window content
                  window.location.href="#Top"
                End Sub
                
                
                Sub RunScript
                   on Error Resume Next
                
                   strUsr = Trim(UsrnameArea.Value)
                   strPas = Trim(PasswordArea.Value)
                   strDept = OptionChooser.value
                
                   minUSRnamelength = 3
                   minPASSwrdlength = 4
                
                   msg = vbNewline
                   br = vbNewline & vbNewline
                
                   If Len(strDept) = 1 Then _
                       msg = msg & "* please select your department!" & br
                   If Len(strUsr) < minUSRnamelength Then _
                       msg = msg & "You have typed an invalid Username." & br
                   If Len(strPas) < minPASSwrdlength Then _
                       msg = msg & "You have typed an invalid Password." & br
                   If Len(msg) > 2 Then MsgBox msg, 64, "Error" : Exit Sub
                
                   If instr(1,strUsr,strDOMAIN,1) < 1 Then
                       strAcc = UCase(strDOMAIN & strUsr) '<--- ************ Prepends the domain to the username ************
                   Else
                       strAcc = UCase(strUsr)
                   End If
                
                   Set objNetwork = CreateObject("WScript.Network")
                   Set oShell = CreateObject("Shell.Application")
                
                   Call ClearDrives ' Delete existing mappings if they exist
                
                   ' <-- ************ Begin Drive mapping ************
                   For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
                     strPath = arrDrives(n,1)
                     strPath = Replace(strPath, "$USR", strUsr, 1, -1, 1)
                     strPath = Replace(strPath, "$DEPT", strDept, 1, -1, 1)
                
                'check.....
                     msgbox  "Drive" & vbTab & ": " & arrDrives(n,0) & vbnewline _
                           & "Path" & vbTab & ": " & strPath & vbnewline _
                           & "Account" & vbTab & ": " & strAcc & vbnewline _
                           & "Password" & vbTab & ": " & strPas
                
                     Err.Clear
                     objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
                     If Err.Number = 0 Then
                       oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
                     End If
                
                   Next
                   ' ************ End Drive Mapping ************
                
                   ' <-- ************ Clean up the objects before exiting ************
                   Set oShell = Nothing
                   Set objNetwork = Nothing
                   Self.Close()
                End Sub
                
                
                Sub DisconnectDrives ' Calls ClearDrives subroutine and then closes the window
                Call ClearDrives
                    Set oShell = Nothing
                    Set objNetwork = Nothing
                Self.close()
                End Sub
                
                
                Sub CancelScript
                   Set oShell = Nothing
                   Set objNetwork = Nothing
                   Self.Close()
                End Sub
                
                </SCRIPT>
                
                <BODY STYLE="font:14 pt arial; color:000000; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#7d8c40', EndColorStr='#7d8c40')">
                <form name="form" id="form" action="">  
                <a name="Top"></a><CENTER>
                <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                    <input type="radio" id="staffradio" name="radioButton" value="StaffDept" />
                    <label for="staffradio">Staff</label>
                    <input type="radio" id="facradio" name="radioButton" value="FacDept" />
                    <label for="facradio">Faculty</label>
                    <input type="radio" id="admradio" name="radioButton" value="AdmDept" />
                    <label for="admradio">Administration</label>
                </table>
                
                <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                    
                    <tr>
                      <td height="30">
                        <p align="right"></p>
                      </td>
                      <td align="center">&nbsp;&nbsp;
                        <select name="noOptions" id="noOptions" style="display: none"> 
                            <option value="Choose an Option" selected="selected">Select An Area Above</option>
                        </select>
                
                        <select name="StaffOptions" id="StaffOptions" style="display: none"> 
                            <option value="Choose an Option" selected="selected">Select A Department</option>
                            <option value="Accounting">Accounting</option>
                            <option value="Advancement">Advancement</option>
                        </select>
                
                        <select name="FacOptions" id="FacOptions" style="display: none"> 
                            <option value="Choose an Option" selected="selected">Select A Department</option>
                            <option value="Art">Art</option>
                            <option value="Biology">Biology</option>
                            <option value="Business">Business</option>
                        </select>
                
                        <select name="AdmOptions" id="AdmOptions" style="display: none"> 
                            <option value="Choose an Option" selected="selected">Select A Department</option>
                            <option value="AcademicAdmin">Academic Administration</option>
                            <option value="FinancialAdmin">Financial Administration</option>
                            <option value="President">President</option>
                        </select>
                
                        <select name="allOptions" id="allOptions" style="display: block"> 
                            <option value="Choose an Option" selected="selected">Select A Department</option>
                            <option value="Choose an Option" selected="selected">Select A Department</option>
                            <option value="Accounting">Accounting</option>
                            <option value="Advancement">Advancement</option>
                            <option value="Art">Art</option>
                            <option value="Biology">Biology</option>
                            <option value="Business">Business</option>
                            <option value="AcademicAdmin">Academic Administration</option>
                            <option value="FinancialAdmin">Financial Administration</option>
                            <option value="President">President</option>
                        </select>
                      </td>
                    </tr>
                    
                    <tr>
                      <td height="30">
                        <p align="right">WWU Username</p>
                      </td>
                      <td height="30">&nbsp;&nbsp; 
                        <input type="text" name="UsrnameArea" size="30">
                      </td>
                    </tr>
                    <tr>
                      <td height="30">
                        <p align="right">WWU Password</p>
                      </td>
                      <td height="30">&nbsp;&nbsp; 
                        <input type="password" name="PasswordArea" size="30">
                      </td>
                    </tr>
                  </table><BR>
                <HR color="#000000">
                 <Input id=runbutton class="button" type="button" value="Connect Drives" name="run_button" onClick="RunScript">
                    &nbsp;
                 <Input id=runbutton class="button" type="button" value="Disconnect Drives" name="dis_button" onClick="DisconnectDrives">
                    &nbsp;
                 <Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button" onClick="CancelScript">
                 <p>
                 <table align="center">
                 myDrives v2.0.1 &nbsp; &copy Babs :: 2012-2013
                </table>
                </CENTER>
                </form>
                
                <SCRIPT Language="javascript">
                window.document.getElementById("noOptions").style.display = "block";
                window.document.getElementById("allOptions").style.display = "none";
                function changeOptions() {
                    var form = window.document.getElementById("form");
                    var StaffOptions = window.document.getElementById("StaffOptions");
                    var FacOptions = window.document.getElementById("FacOptions");
                    var AdmOptions = window.document.getElementById("AdmOptions");
                    
                
                    window.document.getElementById("noOptions").style.display = "none";
                
                    if (form.staffradio.checked) {
                        FacOptions.style.display = "none";
                        AdmOptions.style.display = "none";
                        StaffOptions.style.display = "block";
                        StaffOptions.selectedIndex = 0;
                    } else if (form.facradio.checked) {
                        StaffOptions.style.display = "none";
                        AdmOptions.style.display = "none";
                        FacOptions.style.display = "block";
                        FacOptions.selectedIndex = 0;
                    } else if (form.admradio.checked) {
                        StaffOptions.style.display = "none";
                        FacOptions.style.display = "none";
                        AdmOptions.style.display = "block";
                        AdmOptions.selectedIndex = 0;
                    }
                
                }
                window.document.getElementById("staffradio").onclick = changeOptions;
                window.document.getElementById("facradio").onclick = changeOptions;
                window.document.getElementById("admradio").onclick = changeOptions;
                
                </SCRIPT>
                </BODY>
                </HTML>
                --------------------------------------------------------------------

                Comment


                • #9
                  Re: HTA/VBS Script To Map Network Drives

                  Originally posted by gunnabthe1 View Post
                  [...]
                  my current problem is that when any username/password is entered they "invalid username/password error" is generated. I can't seem to figure out how to fix it. Help? Ideas?
                  Enter the 'form name':

                  Code:
                  Sub RunScript
                     ' on Error Resume Next
                  
                     strUsr = Trim(form.UsrnameArea.Value)
                     strPas = Trim(form.PasswordArea.Value)
                     '  strDept =     ! "OptionChooser" not defined!
                  
                     minUSRnamelength = 3
                     minPASSwrdlength = 4
                  I disabled the on Error Resume Next statement, to be able to see all other errors!

                  /Rems

                  This posting is provided "AS IS" with no warranties, and confers no rights.

                  __________________

                  ** Remember to give credit where credit's due **
                  and leave Reputation Points for meaningful posts

                  Comment


                  • #10
                    Re: HTA/VBS Script To Map Network Drives

                    THANK YOU SO MUCH REMS!!!! That worked like a charm. The script is working splendidly, but I was hoping I could pick your brain(s) at least once more?...

                    I need this script to use the drop down selection to populate part of the file path for my second drive mapping (see bold code). Additionally, I need the last drive mapping to use the inputted username in the file path (see bold code).

                    Code:
                     
                    dim arrDrives(2,2)
                    intMaxdrives = 2
                    
                    arrDrives(0,0) = "K:"
                    arrDrives(0,1) = "\\172.20.1.6\Shared"
                    arrDrives(0,2) = "Shared"
                    
                    arrDrives(1,0) = "I:"
                    arrDrives(1,1) = "\\cpfs-cfs.sky.local\Departments-Staff\PULL FROM DROPDOWN MENU"
                    arrDrives(1,2) = "Department Drive"
                    
                    arrDrives(2,0) = "P:"
                    arrDrives(2,1) = "\\cpfs.sky.local\Home\strUsr\My Documents"
                    arrDrives(2,2) = "My Documents"

                    Comment


                    • #11
                      Re: HTA/VBS Script To Map Network Drives

                      Originally posted by gunnabthe1 View Post

                      I need this script to use the drop down selection to populate part of the file path for my second drive mapping (replacing "\$DEPT" with the value of strDEPT). Additionally, I need the last drive mapping to use the inputted username in the file path (replacing "\$USR" with the value of strUSR).
                      This should work:
                      Code:
                      <HTML>
                      <HEAD>
                      <TITLE> myDrives - WWU Network Drive Tool</title>
                      <HTA:APPLICATION
                      ICON="designer.ico"
                           ApplicationName="myDrives.HTA"
                           SingleInstance="Yes"
                           WindowsState="Normal"
                           Scroll="No"
                           Navigable="Yes"
                           MaximizeButton="No"
                           SysMenu="Yes"
                           Caption="Yes"
                      ></HEAD>
                      
                      <SCRIPT LANGUAGE="VBScript">
                      dim strDEPT
                      dim strUSR
                      
                      '<--- ************ Define Drive Mappings ************
                      dim arrDrives(2,2)
                      intMaxdrives = 2
                      
                      arrDrives(0,0) = "K:"
                      arrDrives(0,1) = "\\172.20.1.6\Shared"
                      arrDrives(0,2) = "Shared"
                      
                      arrDrives(1,0) = "I:"
                      arrDrives(1,1) = "\\cpfs-cfs.skynet.local\Departments-Staff\$DEPT"
                      arrDrives(1,2) = "Department"
                      
                      arrDrives(2,0) = "P:"
                      arrDrives(2,1) = "\\cpfs.skynet.local\Home\$USR"
                      arrDrives(2,2) = "My Documents"
                      
                      '<--- ************ Domain to prepend to the username ************
                      strDOMAIN = "skynet\"
                      
                      Sub Window_Onload
                        Window.resizeTo:Window.moveTo
                        '# Size Window
                        sHorizontal = 440
                        sVertical = 280
                      
                        '# Get Monitor Details
                        Set objWMIService = GetObject _
                          ("winmgmts:root\cimv2")
                        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
                        Next
                        Set objWMIService = Nothing
                        '# default window content
                        window.location.href="#Top"
                        '# Center window on the screen
                        intLeft = (intHorizontal - sHorizontal) /2
                        intTop = (intVertical - sVertical) /2
                        Window.moveTo intLeft, intTop
                        Window.resizeTo sHorizontal, sVertical
                      End Sub
                      
                      sub GetVal(iradio)
                         Select Case iradio
                           case "StaffOptions"
                             strDEPT = form.StaffOptions.value
                           case "FacOptions"
                             strDEPT = form.FacOptions.value
                           case "AdmOptions"
                             strDEPT = form.AdmOptions.value
                         End Select
                      End Sub
                      
                      
                      Sub RunScript
                         MAPDRIVES = FALSE  '(If FALSE it is a test run. set to TRUE for actually mapping the drives)
                      
                         strUSR = Trim(form.UsrnameArea.Value)
                         strPas = Trim(form.PasswordArea.Value)
                      
                         minUSRnamelength = 3
                         minPASSwrdlength = 4
                      
                         msg = vbNewline
                         br = vbNewline & vbNewline
                      
                         If Len(strDEPT) < 1 Then _
                             msg = msg & "* please select your department!" & br
                         If Len(strUSR) < minUSRnamelength Then _
                             msg = msg & "You have typed an invalid Username." & br
                         If Len(strPas) < minPASSwrdlength Then _
                             msg = msg & "You have typed an invalid Password." & br
                         If Len(msg) > 2 Then MsgBox msg, 64, "Error" : Exit Sub
                      
                         If instr(1,strUSR,strDOMAIN,1) < 1 Then
                             strAcc = UCase(strDOMAIN & strUSR) '<--- ************ Prepends the domain to the username ************
                         Else
                             strAcc = UCase(strUsr)
                         End If
                      
                         on Error Resume Next
                         Set objNetwork = CreateObject("WScript.Network")
                         Set oShell = CreateObject("Shell.Application")
                      
                         Call ClearDrives ' Delete existing mappings if they exist
                      
                         ' <-- ************ Begin Drive mapping ************
                         For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
                           strPath = arrDrives(n,1)
                           strPath = Replace(strPath, "$USR", strUSR, 1, -1, 1)
                           strPath = Replace(strPath, "$DEPT", strDEPT, 1, -1, 1)
                      
                      ''''''''''''''''''''
                      Err.Clear
                         If not IsTrue(MAPDRIVES) then
                           'check.....
                           msgbox  "Drive" & vbTab & ": " & arrDrives(n,0) & vbnewline _
                                 & "Path" & vbTab & ": " & strPath & vbnewline _
                                 & "Account" & vbTab & ": " & strAcc & vbnewline _
                                 & "Password" & vbTab & ": " & strPas
                         Else
                           objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
                           If Err.Number = 0 Then
                             oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
                           End If
                         End If
                      ''''''''''''''''''''
                      
                         Next
                         ' ************ End Drive Mapping ************
                      
                         ' <-- ************ Clean up the objects before exiting ************
                         Set oShell = Nothing
                         Set objNetwork = Nothing
                         Self.Close()
                      End Sub
                      
                      
                      ' **** MISSING  Sub ClearDrives ' <--- ****** Sub Routine to remove the drives if they are already mapped ******
                      
                      
                      Sub DisconnectDrives ' Calls ClearDrives subroutine and then closes the window
                      Call ClearDrives
                          Set oShell = Nothing
                          Set objNetwork = Nothing
                      Self.close()
                      End Sub
                      
                      
                      Sub CancelScript
                         Set oShell = Nothing
                         Set objNetwork = Nothing
                         Self.Close()
                      End Sub
                      
                      </SCRIPT>
                      
                      <BODY STYLE="font:14 pt arial; color:000000; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#7d8c40', EndColorStr='#7d8c40')">
                      <form name="form" id="form" method="post"  action="">  
                      <a name="Top"></a><CENTER>
                      
                      <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                          <input type="radio" id="staffradio" name="radioButton" value="StaffDept" />
                          <label for="staffradio">Staff</label>
                      
                          <input type="radio" id="facradio" name="radioButton" value="FacDept" />
                          <label for="facradio">Faculty</label>
                      
                          <input type="radio" id="admradio" name="radioButton" value="AdmDept" />
                          <label for="admradio">Administration</label>
                      </table>
                      
                      <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                          <tr>
                            <td height="30">
                              <p align="right"></p>
                            </td>
                            <td align="center">&nbsp;&nbsp;
                      
                              <select name="noOptions" id="noOptions" style="display:none"> 
                                  <option value="Choose an Option" selected="selected">Select An Area Above</option>
                              </select>
                      
                              <select name="StaffOptions" onChange="GetVal('StaffOptions')" style="display: none"> 
                                  <option value="Choose an Option" selected="selected">Select A Department</option>
                                  <option value="Accounting">Accounting</option>
                                  <option value="Advancement">Advancement</option>
                              </select>
                      
                              <select name="FacOptions" onChange="GetVal('FacOptions')" style="display:none"> 
                                  <option value="Choose an Option" selected="selected">Select A Department</option>
                                  <option value="Art">Art</option>
                                  <option value="Biology">Biology</option>
                                  <option value="Business">Business</option>
                              </select>
                      
                              <select name="AdmOptions" onChange="GetVal('AdmOptions')" style="display:none"> 
                                  <option value="Choose an Option" selected="selected">Select A Department</option>
                                  <option value="AcademicAdmin">Academic Administration</option>
                                  <option value="FinancialAdmin">Financial Administration</option>
                                  <option value="President">President</option>
                              </select>
                      
                            </td>
                          </tr>
                          
                          <tr>
                            <td height="30">
                              <p align="right">WWU Username</p>
                            </td>
                            <td height="30">&nbsp;&nbsp; 
                              <input type="text" name="UsrnameArea" size="30">
                            </td>
                          </tr>
                          <tr>
                            <td height="30">
                              <p align="right">WWU Password</p>
                            </td>
                            <td height="30">&nbsp;&nbsp; 
                              <input type="password" name="PasswordArea" size="30">
                            </td>
                          </tr>
                        </table><BR>
                      <HR color="#000000">
                       <Input id=runbutton class="button" type="button" value="Connect Drives" name="run_button" onClick="RunScript">
                          &nbsp;
                       <Input id=runbutton class="button" type="button" value="Disconnect Drives" name="dis_button" onClick="DisconnectDrives">
                          &nbsp;
                       <Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button" onClick="CancelScript">
                       <p>
                       <table align="center">
                       myDrives v2.0.1 &nbsp; &copy Babs :: 2012-2013
                      </table>
                      </CENTER>
                      </form>
                      
                      <SCRIPT Language="javascript">
                      window.document.getElementById("noOptions").style.display = "block";
                      window.document.getElementById("staffradio").onclick = changeOptions;
                      window.document.getElementById("facradio").onclick = changeOptions;
                      window.document.getElementById("admradio").onclick = changeOptions;
                      // doc
                      
                      function changeOptions() {
                          var form = window.document.getElementById("form");
                          var StaffOptions = window.document.getElementById("StaffOptions");
                          var FacOptions = window.document.getElementById("FacOptions");
                          var AdmOptions = window.document.getElementById("AdmOptions");
                          //
                          window.document.getElementById("noOptions").style.display = "none";
                      
                          if (form.staffradio.checked) {
                              FacOptions.style.display = "none";
                              AdmOptions.style.display = "none";
                              StaffOptions.style.display = "block";
                          } else if (form.facradio.checked) {
                              StaffOptions.style.display = "none";
                              AdmOptions.style.display = "none";
                              FacOptions.style.display = "block";
                          } else if (form.admradio.checked) {
                              StaffOptions.style.display = "none";
                              FacOptions.style.display = "none";
                              AdmOptions.style.display = "block";
                          }
                      }
                      </SCRIPT>
                      
                      
                      </BODY>
                      </HTML>
                      Note, I left the subroutine ClearDrives out because of the max chars limit for posting to the forums.

                      /Rems

                      This posting is provided "AS IS" with no warranties, and confers no rights.

                      __________________

                      ** Remember to give credit where credit's due **
                      and leave Reputation Points for meaningful posts

                      Comment


                      • #12
                        SOLVED: HTA/VBS Script To Map Network Drives

                        Thanks again for the reply, Rems! I actually formulated and implemented an alternate solution just this morning. It may not be as elegant as yours, but it worked for me. I have copied it below for your viewing pleasure. I also added an "info" link (separate file, not linked here). Credit given.

                        Code:
                        <HTML>
                        <HEAD>
                        <TITLE> myDrives - WWU Network Drive Tool</title>
                        <HTA:APPLICATION
                             Icon="mydrives_icon.ico"
                             ApplicationName="myDrives.HTA"
                             SingleInstance="Yes"
                             WindowsState="Normal"
                             Scroll="No"
                             Navigable="Yes"
                             MinimizeButton="No"
                             MaximizeButton="No"
                             SysMenu="Yes"
                             Caption="Yes"
                             Border="Thin"
                        ></HEAD>
                        
                        <SCRIPT LANGUAGE="VBScript">
                        
                        ' <--- ************ Domain to prepend to the username ************
                        strDOMAIN = "skynet\" 
                        
                        Sub Window_Onload
                        
                          ' <-- ************ # Size Window ************
                          sHorizontal = 460
                          sVertical = 240
                          Window.resizeTo sHorizontal, sVertical
                          
                          ' <-- ************ # Get Monitor Details ************
                          Set objWMIService = GetObject _
                            ("winmgmts:root\cimv2")
                          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
                          Next
                          Set objWMIService = Nothing
                          
                          ' <-- ************ # Center window on the screen ************
                          intLeft = (intHorizontal - sHorizontal) /2
                          intTop = (intVertical - sVertical) /2
                          Window.moveTo intLeft, intTop
                          
                          ' <-- ************ # default window content ************
                          window.location.href="#Top"
                        End Sub
                        
                        
                        Sub RunScript
                           on Error Resume Next
                        
                           ' <-- ************ Variables for grabbing username and password ************
                           strUsr = Trim(form.UsrnameArea.Value)
                           strPas = Trim(form.PasswordArea.Value)
                           
                           ' <-- ************ Statement that specifies which drop down to look at, based on raidio button selection ************
                           If form.staffradio.checked = true Then
                            strDrive = Trim(form.StaffOptions.Value)
                            
                           elseif form.facradio.checked = true Then
                            strDrive = Trim(form.FacOptions.Value)
                            
                           elseif form.admradio.checked = true Then
                            strDrive = Trim(form.AdmOptions.Value)
                            
                           end if
                           
                           ' <-- ************ Define Drive Mappings ************
                           dim arrDrives(2,2)
                           intMaxdrives = 2
                        
                           arrDrives(0,0) = "K:"
                           arrDrives(0,1) = "\\172.20.1.6\Shared"
                           arrDrives(0,2) = "Shared"
                        
                           arrDrives(1,0) = "I:"
                           arrDrives(1,1) = "\\cpfs-cfs.skynet.local\Departments-"& strDrive
                           arrDrives(1,2) = "Department Drive"
                        
                           arrDrives(2,0) = "P:"
                           arrDrives(2,1) = "\\cpfs.skynet.local\Home\"& strUsr &"\My Documents"
                           arrDrives(2,2) = "My Documents"
                        
                           ' <-- ************ Minimum username and password length ************
                           minUSRnamelength = 3
                           minPASSwrdlength = 4
                        
                           Set objNetwork = CreateObject("WScript.Network")
                           Set oShell = CreateObject("Shell.Application")
                        
                           If Len(strUsr) >= minUSRnamelength then
                              '<--- ************ Prepends the domain to the username ************
                              strUsr = strDOMAIN & UCase(strUsr) 
                        
                              if Len(strPas) >= minPASSwrdlength Then
                                 Call ClearDrives ' Delete existing mappings if they exist
                                 
                                 ' <-- ************ Begin drive mapping and loop thorugh the array of drives ************
                                 For n = 0 To intMaxDrives
                                    Err.Clear
                                    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
                                 Next
                                  
                                 ELSE
                                    Msgbox "You have typed an incorrect Password."
                                    Exit Sub
                                 End If
                           ELSE
                              Msgbox "You have typed an incorrect Username."
                              Exit Sub
                           End If
                           
                           ' <-- ************ Clean up the objects before exiting ************
                           Set oShell = Nothing
                           Set objNetwork = Nothing
                           Self.Close()
                        End Sub
                        
                        ' <--- ****** Sub routine to remove the drives if they are already mapped ******
                        Sub ClearDrives 
                          On Error Resume Next
                          Set objNetwork = CreateObject("WScript.Network")
                          objNetwork.RemoveNetworkDrive "K:"
                          objNetwork.RemoveNetworkDrive "I:"
                          objNetwork.RemoveNetworkDrive "P:"
                        End Sub
                        
                        ' <-- ************ Calls ClearDrives subroutine and then closes the window ************
                        Sub DisconnectDrives 
                        Call ClearDrives
                            Set oShell = Nothing
                            Set objNetwork = Nothing
                        Self.close()
                        End Sub
                        
                        
                        Sub CancelScript
                           Set oShell = Nothing
                           Set objNetwork = Nothing
                           Self.Close()
                        End Sub
                        
                        </SCRIPT>
                        
                        <BODY STYLE="font:14 pt arial; color:000000; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#FFFFFF', EndColorStr='#FFFFFF')">
                        <form name="form" id="form" action="">  
                        <a name="Top"></a><CENTER>
                        <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                            <input type="radio" id="staffradio" name="radioButton" value="Staff\" />
                            <label for="staffradio">Staff</label>
                            <input type="radio" id="facradio" name="radioButton" value="Faculty\" />
                            <label for="facradio">Faculty</label>
                            <input type="radio" id="admradio" name="radioButton" value="Staff\" />
                            <label for="admradio">Administration</label>
                        </table>
                        
                        <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                            
                            <tr>
                              <td height="30">
                                <p align="right"></p>
                              </td>
                              <td align="center">&nbsp;&nbsp;
                                <select name="noOptions" id="noOptions" style="display: none"> 
                                    <option value="Choose an Option" selected="selected">Select An Area Above</option>
                                </select>
                        
                                <select name="StaffOptions" id="StaffOptions" style="display: none"> 
                                    <option value="Choose an Option" selected="selected">Select A Department</option>
                                    <option value="Staff\Accounting">Accounting</option>
                                    <option value="Staff\Advancement">Advancement</option>
                                    <option value="Staff\Advisement">Advisement</option>
                                </select>
                        
                                <select name="FacOptions" id="FacOptions" style="display: none"> 
                                    <option value="Choose an Option" selected="selected">Select A Department</option>
                                    <option value="Faculty\Art">Art</option>
                                    <option value="Faculty\Biology">Biology</option>
                                    <option value="Faculty\Business">Business</option>
                                </select>
                        
                                <select name="AdmOptions" id="AdmOptions" style="display: none"> 
                                    <option value="Choose an Option" selected="selected">Select A Department</option>
                                    <option value="Staff\AcademicVP">Academic Administration</option>
                                    <option value="Staff\FinancialVP">Financial Administration</option>
                                </select>
                        
                                <select name="allOptions" id="allOptions" style="display: none"> 
                                    <option value="Choose an Option" selected="selected">Select A Department</option>
                                    <option value="Accounting">Accounting</option>
                                    <option value="Advancement">Advancement</option>
                                    <option value="Advisement">Advisement</option>
                                    <option value="Art">Art</option>
                                    <option value="Biology">Biology</option>
                                    <option value="Business">Business</option>
                                    <option value="AcademicVP">Academic Administration</option>
                                    <option value="FinancialVP">Financial Administration</option>
                                </select>
                              </td>
                            </tr>
                            
                            <tr>
                              <td height="30">
                                <p align="right">WWU Username</p>
                              </td>
                              <td height="30">&nbsp;&nbsp; 
                                <input type="text" name="UsrnameArea" size="30">
                              </td>
                            </tr>
                            <tr>
                              <td height="30">
                                <p align="right">WWU Password</p>
                              </td>
                              <td height="30">&nbsp;&nbsp; 
                                <input type="password" name="PasswordArea" size="30">
                              </td>
                            </tr>
                          </table><BR>
                        <HR color="#000000">
                         <Input id=runbutton class="button" type="button" value="Connect Drives" name="run_button" onClick="RunScript">
                            &nbsp;
                         <Input id=runbutton class="button" type="button" value="Disconnect Drives" name="dis_button" onClick="DisconnectDrives">
                            &nbsp;
                         <Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button" onClick="CancelScript">
                            &nbsp;
                         <a href="myDrives_Info.hta"><img border="0" src="question.png" alt="info" width="11" height="17"></a>
                         <p>
                        </CENTER>
                        </form>
                        
                        <SCRIPT Language="javascript">
                        window.document.getElementById("noOptions").style.display = "block";
                        window.document.getElementById("allOptions").style.display = "none";
                        function changeOptions() {
                            var form = window.document.getElementById("form");
                            var StaffOptions = window.document.getElementById("StaffOptions");
                            var FacOptions = window.document.getElementById("FacOptions");
                            var AdmOptions = window.document.getElementById("AdmOptions");
                            
                        
                            window.document.getElementById("noOptions").style.display = "none";
                        
                            if (form.staffradio.checked) {
                                FacOptions.style.display = "none";
                                AdmOptions.style.display = "none";
                                StaffOptions.style.display = "block";
                                StaffOptions.selectedIndex = 0;
                            } else if (form.facradio.checked) {
                                StaffOptions.style.display = "none";
                                AdmOptions.style.display = "none";
                                FacOptions.style.display = "block";
                                FacOptions.selectedIndex = 0;
                            } else if (form.admradio.checked) {
                                StaffOptions.style.display = "none";
                                FacOptions.style.display = "none";
                                AdmOptions.style.display = "block";
                                AdmOptions.selectedIndex = 0;
                            }
                        
                        }
                        window.document.getElementById("staffradio").onclick = changeOptions;
                        window.document.getElementById("facradio").onclick = changeOptions;
                        window.document.getElementById("admradio").onclick = changeOptions;
                        
                        </SCRIPT>
                        </BODY>
                        </HTML>
                        Last edited by gunnabthe1; 16th May 2013, 18:04.

                        Comment


                        • #13
                          Re: HTA/VBS Script To Map Network Drives

                          Hi,

                          Not sure if this is an easy addition but it's something I am struggling with.

                          I am trying to add something like this to work alongside the script -

                          Set WSHShell = WScript.CreateObject("WScript.Shell")
                          vbConnectionName = "VPNConnection"
                          vbConnectionUser = "strUsr"
                          vbConnectionPassword = "strPas"
                          vbConnectWith = "rasdial" & " """ & vbConnectionName & """ """ & vbConnectionUser & """ """ & vbConnectionPassword & """"
                          WSHShell.Run vbConnectWith

                          What I am trying to achieve is when the user has entered the username and password it uses those details to dial a VPN called "VPNConnection" and then map the network drive using the same credentials.

                          I can get both scripts to work seperately but I am struggling to merge them together.

                          any help would be great.

                          Comment

                          Working...
                          X