How to change drive letters (VBScript)

Hi all,

Imagine you need to map some shared folders to specific drive letters for all users in your domain, so some internal apps your company needs work fine. Imagine your users connected i.e. USB devices to their systems, so the drive letters those apps need are in use when you are going to map them.

The following VBScript sample accepts a list of forbidden drive letters, and it will rename all the drive letters of the system in that list to the next available letter.

 Option Explicit

'************************************************************************
' PARAMETERS
'************************************************************************

' Reserved drives list
'
Dim arrReservedDrives
arrReservedDrives = Array("E:", "F:", "H:", "Y:", "Z:")

wscript.echo "Reserved drives:"
ShowArray arrReservedDrives



'************************************************************************
' MAIN
'************************************************************************

Dim objWMIService, objDrive
Dim colDrives
Dim arrUsedDrives, arrForbiddenDrives
Dim strComputer, strDrive, strNewDrive, strCurrentDrive
Dim i

' Get all drives currently in use
'
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colDrives = objWMIService.ExecQuery _
    ("Select * from Win32_LogicalDisk")

ReDim arrUsedDrives(colDrives.Count - 1)    
i = 0
For Each objDrive in colDrives
    arrUsedDrives(i) = objDrive.DeviceID
    i = i + 1
Next

wscript.echo "Used drives:"
ShowArray arrUsedDrives

' Create a list which contains all drives in use + all reserved drives. 
' Drives in this list cannot be used at all. 
' Note I don't care about duplicated values in this list
'
arrForbiddenDrives = JoinArrays(arrUsedDrives, arrReservedDrives)

' Check each drive currently in use
'
For Each strDrive in arrUsedDrives
    If ArrayContains(arrReservedDrives, strDrive) Then
    
        ' We found a drive that cannot be used
        '
        Wscript.echo strDrive & " is in use, and it shouldn't"
        
        ' Find next available drive
        '
        strNewDrive = ""
        For i = 68 to 90 ' From 'D' to 'Z'
            strCurrentDrive = CStr(Chr(i)) & ":"
            If (Not ArrayContains(arrForbiddenDrives, strCurrentDrive)) Then
                ' We found it
                '
                strNewDrive = strCurrentDrive
                Exit For
            End If 
        Next
        
        If strNewDrive = "" Then
            ' There are no more available drives!
            '
            Wscript.echo "Error: There are no more available drives in the system!!!!"
            Exit For
        End If

        ' Change drive that cannot be used to the available drive we found
        '
        wscript.echo "Changing " & strDrive & " to " & strNewDrive
        ChangeDriveLetterWithMountvol strDrive, strNewDrive
        wscript.echo
        
        ' Add the new drive to the list of forbidden drives
        '
        AddToArray arrForbiddenDrives, strNewDrive
    End If
Next

' The end
'
wscript.echo "We are done!"



'************************************************************************
' HELPER FUNCTIONS
'************************************************************************

' Change the drive in one drive letter to another drive letter using
' mountvol.exe tool
'
Sub ChangeDriveLetterWithMountvol(strSourceDrive, strTargetDrive) 

    Dim objShell, objExec
    Dim strVolume
    
    Set objShell = WScript.CreateObject("WScript.Shell")
    
    ' Get volume associated to the old drive letter.
    '
    Set objExec = objShell.Exec("mountvol " & strSourceDrive & " /L")
    strVolume = Trim(objExec.StdOut.ReadLine())
    while objExec.Status = 0
        WScript.Sleep(100)
    Wend
    
    ' Unmount the drive.
    '
    Set objExec = objShell.Exec("mountvol " & strSourceDrive & " /D")
    while objExec.Status = 0
        WScript.Sleep(100)
    Wend
    
    ' Mount the drive on the new drive letter.
    '
    Set objExec = objShell.Exec("mountvol " & strTargetDrive & " " & strVolume)
    while objExec.Status = 0
        WScript.Sleep(100)
    Wend

End Sub 

' Join two arrays
'
Function JoinArrays(arrA, arrB)

    Dim i, a, b
    
    ReDim arrNew(UBound(arrA) + UBound(arrB) + 1)
    
    i = 0
    For a = 0 to UBound(arrA)
        arrNew(i) = arrA(a)
        i = i + 1
    Next

    For b = 0 to UBound(arrB)
        arrNew(i) = arrB(b)
        i = i + 1
    Next
    
    JoinArrays = arrNew
    
End Function

' Looks for a value in an array
'
Function ArrayContains(arrStrings, strValue)

    Dim i
    
    ArrayContains = false
    For i = 0 to UBound(arrStrings)
        If arrStrings(i) = strValue Then
            ArrayContains = true
            Exit For
        End If
    Next
    
End Function

' Adds a value to an array
'
Function AddToArray(arrStrings, strNewValue)

    ReDim Preserve arrStrings(UBound(arrStrings) + 1)
    arrStrings(UBound(arrStrings)) = strNewValue
    AddToArray = arrStrings
    
End Function

' Shows contents of an array of strings
'
Sub ShowArray(arrStrings)

    Dim str
    
    For Each str in arrStrings
        wscript.echo str
    Next
    wscript.echo
    
End Sub

I hope this helps.

Regards,

Alex (Alejandro Campos Magencio)