Déterminer nom et numéro de périphérique

Sub Test()
'source
'http://microsoft.public.fr.excel.narkive.com/aPFXzYCK/liste-des-ports-serie
ListSerialPorts "." ' Ordinateur local
End Sub

Sub ListSerialPorts(sComputer As String)
Dim objWMIService 'As Object
Dim colItems 'As Object
Dim objItem 'As Object
Dim l As Long

Set objWMIService = GetObject("winmgmts:\\" & _
sComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_SerialPort", , 48)
l = 1
For Each objItem In colItems
Cells(l, 1) = objItem.DeviceID
l = l + 1
Next
End Sub