Office: Überprüfen ob ein USB Gerät angeschlossen ist.

User · 20. März 2007

Hallo zusammen,

Mit diesem VBA Code in einem Modul ist es möglich, zu prüfen ob ein USB-Gerät angeschlossen ist oder nicht.
Benutzt VBScripting Functionality.

Die Subroutine dient als Beispiel für den Aufruf der Function. Getestet unter WIN XP / Excel 2000 SP-3.

Wird die Frage nach dem (Teil)Namen mit der Vorgabe beantwortet werden all USB-Schnittstellen-Geräte (per Msgbox) aufgelistet.

Wird die Frage nach dem (Teil)Namen mit einem Ausdruck beantwortet wird geprüft ob ein Gerät in dessen Beschreibung der Ausdruck vorkommt angeschlossen ist. Rückgabewert TRUE = Gerät ist angeschlossen, FALSE = Gerät ist nicht angeschlossen oder ausgeschaltet.

Code:

Option Explicit

Sub PrüfeUSBGerät()
'
' Code vom 23.03.2007 / EtoP, Hansueli Göldi [ohne Gewähr für irgendwas... ;-)]
'
Dim strDevName As String
strDevName = InputBox("Geben Sie den Namen (oder einen Teil)" & vbCrLf & _
"des zu suchenden Gerätes an:", "USB Geräte suchen", "*ListAllUSBDevices*")
If strDevName = "" Then Exit Sub
If checkUSBDevice(strDevName) Then
MsgBox "Das Gerät ist angeschlossen", vbOKOnly + vbInformation, "USB Check"
Else
If strDevName "*ListAllUSBDevices*" Then _
MsgBox "Das Gerät ist NICHT angeschlossen", vbOKOnly + vbExclamation, "USB Check"
End If
End Sub

Public Function checkUSBDevice(strUSBDeviceName As String) As Boolean
Dim objWMIService As Object
Dim objDevice As Object
Dim objUSBDevice As Object
Dim arrDeviceNames As Variant
Dim colUSBDevices As Variant
Dim colDevices As Variant
Dim strDevicename As String

Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colDevices = objWMIService.ExecQuery _
("Select * From Win32_USBControllerDevice")

For Each objDevice In colDevices
arrDeviceNames = Split(Replace(objDevice.Dependent, Chr(34), ""), "=")
strDevicename = arrDeviceNames(1)
Set colUSBDevices = objWMIService.ExecQuery _
("SELECT * From Win32_PnPEntity Where DeviceID = '" & strDevicename & "'")
For Each objUSBDevice In colUSBDevices
If strUSBDeviceName = "*ListAllUSBDevices*" Then MsgBox objUSBDevice.Description
If InStr(objUSBDevice.Description, strUSBDeviceName) > 0 Then
checkUSBDevice = True
End If
Next
Next
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

chris-kaiser · 21. März 2007

hiho

Uhi, danke*top gerade getestet
schaut gut aus
jetzt hast Du schon 2 Bewertungen gut bei mir
werde den Beitrag abonnieren

Office: Überprüfen ob ein USB Gerät angeschlossen ist.

Überprüfen ob ein USB Gerät angeschlossen ist.

Überprüfen ob ein USB Gerät angeschlossen ist.

Überprüfen ob ein USB Gerät angeschlossen ist. - Similar Threads - Überprüfen USB Gerät

Teilstring einer Zelle auf Wert aus anderer Zelle überprüfen

Während der Eingabe überprüfen ob Zahl oder Text

Dateien vorab auf Serienbrief überprüfen

Überprüfen ob Tabellenballt mit Namen aus Zelle vorhanden ist

1.Excel soll 100 Excel-Tabellen überprüfen

Datum & Uhrzeit Überprüfung

Mehrere Zellen auf Inhalt überprüfen