For Each objPart In objPartitions
Буква_съемного_диска = objItem.DeviceID
Next

For Each objItem In colItems
PnP_ID_устройства = objItem.PnPDeviceID
Next

Set colItems = objWMI.ExecQuery("Select * from Win32_DiskDrive", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)

'обнаружение подключенных на компьютере USB накопителей, их ID
Dim objWMI, objLogicalDisks, objLD
Dim objPartitions, objPart, objDrives, objDrive
Dim strComputer, strTemp
strComputer = "."
Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\cimv2")
Set objLogicalDisks = objWMI.ExecQuery _
                   ("SELECT * FROM Win32_LogicalDisk WHERE DriveType=2")
For Each objLD In objLogicalDisks
   Set objPartitions = objWMI.ExecQuery _
                           ("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID=""" & _
                           objLD.DeviceID & _
                           """} WHERE AssocClass=Win32_LogicalDiskToPartition")
   For Each objPart In objPartitions
       Set objDrives = objWMI.ExecQuery _
                           ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
                           objPart.DeviceID & _
                           """} WHERE AssocClass=Win32_DiskDriveToDiskPartition")
       For Each objDrive In objDrives
           strTemp = strTemp & objLD.DeviceID & " => " & objDrive.Caption & " (Диск " & objDrive.Index & ")" & vbNewLine & _
                       "PnPDeviceID накопителя = " & objDrive.PnPDeviceID & vbNewLine & vbNewLine
       Next
       Set objDrive = Nothing
       Set objDrives = Nothing
   Next
   Set objPart = Nothing
   Set objPartitions = Nothing
Next
Set objLD = Nothing
Set objLogicalDisks = Nothing
Set objWMI = Nothing

If Len(strTemp) =  0  Then MsgBox$ "На компьютере USB накопителей не обнаружено", vbOKOnly, "Отчёт" Else MsgBox$ strTemp, vbOKOnly, "Отчёт"

Set objs = GetObject("winmgmts:").InstancesOf("Win32_USBControllerDevice")
For Each obj In objs
   If Right(obj.Dependent, Len(PnPID)) = PnPID Then
           пер1= obj.Dependent
           пер2= obj.Antecedent
   End If
Next