flashercs

Option Explicit
' On Error Resume Next
Dim strDriveLetter,objWbemService,colVolumes,objVolume
strDriveLetter = "D"
Set objWbemService = GetObject("winmgmts:{ImpersonationLevel=Impersonate}!//./root/cimv2")
Set colVolumes = objWbemService.ExecQuery("Select DeviceID,DriveLetter,Label,Name,SerialNumber From Win32_Volume Where BootVolume=False And SystemVolume=False And DriveType=3")
For Each objVolume In colVolumes
'系统盘卷标是Win7 或 Win10
  If LCase(Left(objVolume.Label,3)) = "win" Then
    objVolume.Dismount True,True
    ' ShowError
  Else
    If UCase(Left(objVolume.DriveLetter,1)) <> strDriveLetter Then
      objVolume.DriveLetter = strDriveLetter & ":"
    End If
    If strDriveLetter = "Z" Then Exit For
    strDriveLetter = Chr(Asc(strDriveLetter) + 1)
  End If
Next
Set objVolume = Nothing
Set colVolumes = Nothing
Set objWbemService = Nothing
复制代码