1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
| Sub usb_1()
arrDesc = Array("Concentrateur USB générique", "Périphérique dentrée USB", "Périphérique clavier PIH") ' Description des périphériques voulus
strComputer = "."
strQuotes = Chr(34)
'[A1:B1048576].ClearContents
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDevices = objWMIService.ExecQuery _
("Select Dependent From Win32_USBControllerDevice")
' i = 1
For Each objDevice In colDevices
strDeviceName = (Split(Replace(objDevice.Dependent, strQuotes, ""), "="))(1)
Set colUSBDevices = objWMIService.ExecQuery _
("Select Description, PNPDeviceID From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
For Each objUSBDevice In colUSBDevices
' WScript.Echo objUSBDevice.Description
' WScript.Echo objUSBDevice.PnPDeviceID ' Changed from Description to PnPDeviceID
'as this script can be altered to return any property
'of the Win32_USBControllerDevice collection.
For j = LBound(arrDesc) to UBound(arrDesc)
If objUSBDevice.Description = arrDesc(j) Then
'Range(Cells(i, 1), Cells(i, 1)) = objUSBDevice.Description
'Range(Cells(i, 2), Cells(i, 2)) = objUSBDevice.PNPDeviceID
'i = i + 1
List = List & "Desc: " & objUSBDevice.Description & vbTab & "PNPDeviceID: " & objUSBDevice.PNPDeviceID & vbNewLine
Exit For
End if
Next ' j
Exit For ' C'est ici la modification pour un petit gain de temps: sur ma machine on passe de 6 sec à 2 sec
Next ' objUSBDevice
Next ' objDevice
f.Write list
End Sub
dt0 = Now
set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("DvcID.txt", 2, True)
usb_1
dt1 = Now
diff = DateDiff("s", dt0, dt1)
f.write vbNewLine & "Durée : " & diff & " sec"
f.Close
Createobject("Wscript.shell").Run "DvcID.txt", 1 , False |
Partager