'Developed by Chris Bennett 'http://dwarfsoft.com/ On Error Resume Next Const ForWriting = 2 Const ForReading = 1 Set oShell = CreateObject("WScript.Shell") Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFile = oFSO.OpenTextFile(oShell.ExpandEnvironmentStrings("C:\Temp\dp.txt"),ForWriting,True) oFile.WriteLine("LIST VOLUME") oFile.Close() Set oDrives = oFSO.Drives 'Create a drives collection 'MsgBox FindNextAvailable("C:") & "hi" set proc = oShell.Exec ("diskpart /s C:\Temp\dp.txt") Ouptut = "" Str = "" Do while Not proc.StdOut.AtEndOfStream Str = proc.StdOut.ReadLine If InStr(Str,"Volume") > 0 Then If Not (Mid(Str,10,3) = "###") Then DriveLetter = Mid(Str,16,1) VolumeNumber = Trim(Mid(Str,10,3)) If IsNetworkDrive(DriveLetter) Then NewLetter = FindNextAvailable(DriveLetter) If ChangeDriveLetter(DriveLetter,NewLetter) Then ClearDriveFromFile(NewLetter) End If End If End If End If Loop CleanUpFiles() WScript.Quit Function ChangeDriveLetter(DriveFrom,DriveTo) Set oShell = CreateObject("WScript.Shell") Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFile = oFSO.OpenTextFile(oShell.ExpandEnvironmentStrings("C:\Temp\dp.txt"),ForWriting,True) oFile.WriteLine("SELECT VOLUME " & Trim(DriveFrom)) oFile.WriteLine("ASSIGN LETTER=" & Trim(DriveTo)) oFile.Close() set proc1 = oShell.Exec ("diskpart /s C:\Temp\dp.txt") Str = "" Do while Not proc1.StdOut.AtEndOfStream Str = proc1.StdOut.ReadLine If InStr(Str,"successfully") > 0 Then ChangeDriveLetter = True Exit Function End If Loop ChangeDriveLetter = False End Function Function IsNetworkDrive(Letter) IsNetworkDrive = False Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFile2 = oFSO.OpenTextFile("C:\Temp\nd.txt",ForReading,True) Output = "" Do While Not oFile2.AtEndOfStream Str = oFile2.ReadLine If InStr(Str,Letter) > 0 Then IsNetworkDrive = True Exit Function End If Loop IsNetworkDrive = False End Function Function FindNextAvailable(CurrentLetter) 'WScript.Echo CurrentLetter Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFile3 = oFSO.OpenTextFile("C:\Temp\fd.txt",ForReading,True) Output = "" Do While Not oFile3.AtEndOfStream Str = oFile3.ReadLine If Len(Trim(Str)) > 0 Then FindNextAvailable = Left(Str,1) Exit Function End If Loop FindNextAvailable = "" End Function Function ClearDriveFromFile(Letter) Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFile4 = oFSO.OpenTextFile("C:\Temp\fd.txt",ForReading,True) Output = "" Do While Not oFile4.AtEndOfStream Str = oFile4.ReadLine If InStr(Str,Letter) > 0 Then Else Output = Output & Str & vbNewLine End If Loop Set oFile4 = oFSO.OpenTextFile("C:\Temp\fd.txt",ForWriting,True) oFile4.WriteLine(Output) oFile4.Close() End Function Function CleanUpFiles() Set oShell = CreateObject("WScript.Shell") Set oFSO = CreateObject("Scripting.FileSystemObject") oFSO.DeleteFile("C:\Temp\fd.txt") oFSO.DeleteFile("C:\Temp\nd.txt") oFSO.DeleteFile("C:\Temp\dp.txt") End Function