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. USBdevices to their systems, so the drive lettersthose 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)