For Each obj In objs
If Right(obj.Dependent, Len(PnPID)) = PnPID Then
Код_экземпляра_устройства= strtemp & PnPID & vbCr & obj.Dependent & vbCr & obj.Antecedent
Exit Sub
End If
Next

'класс Win32_DiskDrive предоставляет сведения о дисководах
Dim obj, objs, buf, PnPID, strtemp
Set objs = GetObject("winmgmts:").InstancesOf("Win32_DiskDrive")
Устройства =  0 
USB_устройства =  0 
For Each obj In objs
Устройства = Устройства +  1 
Тип_устройства = obj.InterfaceType 'типы устройства бывают: IDE, USB
If obj.InterfaceType = "USB" Then
USB_устройства = USB_устройства +  1 
PnPID = obj.PnPDeviceID
End If
Next

On Error Resume Next
 
Const wbemFlagReturnImmediately = &H10
Const wbemFlagForwardOnly = &H20
 
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
 
For Each objItem In colItems
    strtemp = strtemp + "_______________________________________________" + Chr( 13 )
    strtemp = strtemp + "_______________________________________________" + Chr( 13 )
    strtemp = strtemp + "Заголовок устройства: " & objItem.Caption + Chr( 13 )
    strtemp = strtemp + "Тип устройства: " & objItem.InterfaceType + Chr( 13 )
    strtemp = strtemp + "ID устройства: " & objItem.DeviceID + Chr( 13 )
    strtemp = strtemp + "PnP ID устройства: " & objItem.PnPDeviceID + Chr( 13 )
    strtemp = strtemp + "Имя устройства: " & objItem.Name + Chr( 13 )
    strtemp = strtemp + "Состояние устройства: " & objItem.Status + Chr( 13 )
    strtemp = strtemp + "_______________________________________________" + Chr( 13 )
    strtemp = strtemp + "_______________________________________________" + Chr( 13 )
Next

Selection.TypeText Text:=strtemp
WScript.Echo strtemp

Dim objWMI, objCollection, objItem, objWSNet
Dim objLogicalDisks, objLD, objPartitions, objPart
Dim strComputer, strTemp
strComputer = "."
Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\cimv2")
Set objCollection = objWMI.ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType=2")
Количество_подсоединённых_USB_устройств =  0 
For Each objItem In objCollection
Set objLogicalDisks = objWMI.ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID=""" & _
objItem.DeviceID & """} WHERE AssocClass=Win32_LogicalDiskToPartition")
For Each objLD In objLogicalDisks
Set objPartitions = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
objLD.DeviceID & """} WHERE AssocClass=Win32_DiskDriveToDiskPartition")
For Each objPart In objPartitions
strTemp = strTemp & objItem.DeviceID & " => " & objPart.Caption & " (Диск " & objPart.Index & ")" & vbNewLine
Буква_съемного_диска = objItem.DeviceID
Имя_съёмного_диска = objPart.Caption
Порядковый_номер_накопителя_на_момент_запроса = objPart.Index
Имя_съёмного_диска_его_буква = objPart.Caption & " " & objItem.DeviceID
Количество_подсоединённых_USB_устройств = Количество_подсоединённых_USB_устройств +  1 
Next
Set objPart = Nothing
Set objPartitions = Nothing
Next
Set objLD = Nothing
Set objLogicalDisks = Nothing
Next
Set objItem = Nothing
Set objCollection = Nothing
Set objWMI = Nothing

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

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