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)
Comments
- Anonymous
December 01, 2010
EXACTLY what i needed! Tried to script this myself but this is way better. Interesting to see how you solved the problems I had with my script.Learned a lot from this, thank you! - Anonymous
July 07, 2013
THANKS! Been looking for a solution this clean for awhile now! - Anonymous
February 21, 2014
This is EXTREMELY helpful! We had a problem with a Windows 7 sysprep prepared image, that had problems with EJECTED drives if the drive was D. Only drive D was a problem. Example is that CD ROM or USB card reader on D, after media ejected, would cause problems with popup "No Disk", "There is no disk in the drive. Please insert a disk into drive D:." Cancel, Try Again, Continue". With this script, we can REMAP whatever is consuming D to the next available drive letter. This script has more uses than just reserving for mapped network drives! THANK YOU!