Map Local Drive VB Script

MapLocalDrive.vbs

Dim WshShell, FileShell, MapPrompt, WhatToDo, DrvLetter, TestDrvLetter, Dummy, Confirm
Dim BrowseDialogBox, SelectedFolder, FullPath, FullPathString, DrivePath, OpenWEX, TheLetters, MapDis
Dim TempDrvLetter, ColonTest, TheFile, IsLetter

Set WshShell = WScript.CreateObject("WScript.Shell")
Set FileShell = WScript.CreateObject("Scripting.FileSystemObject")

MapPrompt = "What would you like to do?" & vbCrLf & vbCrLf &_
"     1)  Map Local Drive" & vbCrLf &_
"     2)  Disconnect Mapped Local Drive" & vbCrLf &_
"     3)  View Mapped Local Drives" & vbCrLf &_
"     4)  Quit" & vbCrLf

Do

  WhatToDo = InputBox(MapPrompt, "Map Local Drive")

  Select Case WhatToDo

    Case "1" Call Mapping
    Case "2" Call Disconnecting
    Case "3" Call Viewing
    Case "4" 'Quit
    Case "" 'Cancel 
    Case Else 
          Dummy = MsgBox("Not a valid selection!", 16, "Map Local Drive")
          WhatToDo = "0"
  
  End Select

Loop Until WhatToDo = 4 or WhatToDo = ""

Wscript.Quit

'*********************************************************************************************************************************************

Sub Mapping

DrvLetter = GetDrvLetter("Map")
TestDrvLetter = DrvExists(DrvLetter)

If TestDrvLetter Then
  Dummy = MsgBox("The drive letter you chose is already in use!" & vbCrLf & vbCrLf &_
  "      Please select another letter.", 16, "Map Local Drive")
Else
  Set BrowseDialogBox = WScript.CreateObject("Shell.Application")
  Set SelectedFolder = BrowseDialogBox.BrowseForFolder(0, "Select the folder that you want to Map to.", &H0002)

  If InStr(1, TypeName(SelectedFolder), "Folder") = 0 Then
    Wscript.Quit
  Else
    FullPath = SelectedFolder.ParentFolder.ParseName(SelectedFolder.Title).Path
    FullPathString = CStr(FullPath)
    DrivePath = "SUBST "& DrvLetter & " " & """" & FullPathString & """"
    WshShell.Run DrivePath, 2, True
    OpenWEX = "explorer.exe /n,/e," & DrvLetter & "\"
    WshShell.Run OpenWEX, 1, True
    WhatToDo = "4"
  End If

End If

End Sub 'Mapping

'*********************************************************************************************************************************************

Sub Disconnecting

DrvLetter = GetDrvLetter("Disconnect")
If DrvLetter = "0" Then Exit Sub
TestDrvLetter = DrvExists(DrvLetter)

If TestDrvLetter Then
  
  DrivePath = "SUBST /d "& DrvLetter
  WshShell.Run DrivePath, 2, False
  Confirm = "Drive " & DrvLetter & " has been disconnected"
  Dummy = WshShell.Popup (Confirm, 5, "Map Local Drive", 64)
Else
  Dummy = MsgBox("The drive letter you chose doesn't exist." & vbCrLf & vbCrLf &_
  "Please select another letter!", 16, "Map Local Drive")
End If

End Sub 'Disconnecting

'*********************************************************************************************************************************************

Sub Viewing

TheLetters =  ViewMappedDrvs()
Dummy = MsgBox("These are the currently mapped drives: " & vbCrLf & vbCrLf &_
TheLetters, 64, "Map Local Drive")

End Sub 'Viewing

'*********************************************************************************************************************************************

Function GetDrvLetter(MapDis)

If MapDis = "Map" Then
  TempDrvLetter = InputBox(vbCrLf &_
  "Please type the drive letter that you would like to map to a local folder:", "Map Local Drive")
Else
  TheLetters = ViewMappedDrvs()
  If TheLetters = "   There are no mapped drive letters!" Then
    Dummy = MsgBox(TheLetters, 16, "Map Local Drive")
    GetDrvLetter = "0"
    Exit Function
  Else
    TempDrvLetter = InputBox(vbCrLf &_
    "What drive letter would you like to disconnect?" & vbCrLf & vbCrLf &_
    TheLetters, "Map Local Drive")
   End If
End If

TempDrvLetter = IsValidDrvLetter(TempDrvLetter)
ColonTest = Right(TempDrvLetter,1)
If ColonTest <> ":" Then TempDrvLetter = TempDrvLetter & ":"
GetDrvLetter = TempDrvLetter

End Function 'GetDrvLetter

'*********************************************************************************************************************************************

Function IsValidDrvLetter(TempDrvLetter)

If TempDrvLetter = "" Then Wscript.Quit

TempDrvLetter = UCase(TempDrvLetter)
IsLetter = Asc(TempDrvLetter)

If (IsLetter => 65) and (IsLetter <= 90) Then
  IsValidDrvLetter = TempDrvLetter
Else
  Dummy = MsgBox("You must type a valid drive letter!", 16, "Map Local Drive")
  Wscript.Quit
End If

End Function 'IsValidDrvLetter

'*********************************************************************************************************************************************

Function DrvExists(DrvLetter)

  If FileShell.DriveExists(DrvLetter) Then
    DrvExists = True
  Else
    DrvExists = False
  End If

End Function 'DrvExists

'*********************************************************************************************************************************************

Function ViewMappedDrvs()

WshShell.Run "%COMSPEC% /c Subst > c:\Subst.txt"
Wscript.Sleep 100
Set TheFile = FileShell.GetFile("c:\Subst.txt")
If TheFile.Size = 0 Then 
  ViewMappedDrvs =  "   There are no mapped drive letters!"
Else
  Set TheFile = FileShell.OpenTextFile("c:\Subst.txt", 1)
  ViewMappedDrvs = TheFile.ReadAll
  TheFile.Close
  Set TheFile = FileShell.GetFile("c:\Subst.txt")
  TheFile.Delete
End If 

End Function 'ViewMappedDrvs