Seriennummerabfrage auf USB-Stick

[Winfried]

Hallo zusammen,

ist es möglich in Excel eine Hardwareabfrage per VB durchzuführen ?

Ich möchte auf einem USB-Stick eine Exceldatei hinterlegen. Beim Start dieser Datei soll zuerst eine Hardwareabfrage durchgeführt werden. Ist ein USB-Stick vorhanden, wenn ja hat er die Seriennunner 0815. Wenn ja wird die Datei gestartet, wenn nein kommt eine Fehlermeldung.

Bin leider ein absoluter Laie was dies anbelangt und bn auf eure Antworten gespannt.

Viele Grüße

Winfried Hägle

[Herbert Grom]

Hallo Winfried,

damit geht es:

Sub USB_ID_auslesen()
   Dim objFSO, objLaufwerk, strLaufwerk As String, USB_ID$
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   On Error GoTo ende
   For Each objLaufwerk In objFSO.Drives
      If objLaufwerk.IsReady Then
         If objLaufwerk.DriveType = "1" Then USB_ID = objLaufwerk.SerialNumber
      End If
   Next objLaufwerk
ende:
   Set objFSO = Nothing
End Sub

Viel Erfolg

Servus

[Winfried]

Hallo Herbert,

vieeeelen Dank für die Antwort, dass muss ich natürlich sofort versuchen !!!

Gruß

Winfried

[Winfried]

hab doch noch eine Frage, wo müßte ich jetzt zbs. die von mir vorgegebene Seriennummer 0815 eintragen ?

[Herbert Grom]

Ich weiß ja nicht, was Du damit machen willst! Vielleicht könntest Du mir mal Dein Vorhaben komplett schildern!

[Winfried]

wie oben schon beschrieben --> wenn die Seriennummer vom USB-Stick, worauf sich die Exceldatei befindet,  nicht übereinstimmt ( also zbs. die Seriennummer 0815) dann sollte diese Datei nicht geöffnet werden können. Eigentlich ein Kopierschutz...

Gruß

Winfried

[Officer]

Hallo Winfried,

Herbert Grom ist ein Mitarbeiter von Excel-Inside. Ich habe den Code schnell genommen und eine kleine Erläuterung dazu bei Excel-Inside online gestellt. http://www.excel-inside.de/vba-loesungen/sonstiges/933-makro-kann-nur-von-einem-bestimmten-usb-stick-aus-gestartet-werden

Schau dir das mal an, ob du damit weiterkommst.

Ansonsten können wir auch gerne mal darüber nachdenken, wie wir dich in deinem Vorhaben unterstützten können.

Viele Grüße
Alois [alias Officer]

[Herbert Grom]

Hallo Winfried,

kopiere diesen Code in ein Standardmodul und passe ihn an den entsprechenden Stellen an:

Option Explicit

Public Const sConst_USB_ID$ = "1234567" '* <== anpassen

Sub USBID_auslesen()

   Dim USB_ID As Long
   
   Call USB_ID_auslesen

   '* wenn ID des USB-Stick nicht mit der hinterlegten überein stimmt, dann
      If USB_ID <> sConst_USB_ID Then '* hier einfügen was weiter geschehen soll

End Sub


Sub USB_ID_auslesen()
   Dim objFSO, objLaufwerk, strLaufwerk As String, USB_ID$
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   On Error GoTo ende
   For Each objLaufwerk In objFSO.Drives
      If objLaufwerk.IsReady Then
         If objLaufwerk.DriveType = "1" Then USB_ID = objLaufwerk.SerialNumber
      End If
   Next objLaufwerk
ende:
   Set objFSO = Nothing
End Sub


Servus

[Winfried]

wowwww vielen Dank euch beiden.

Und das Makro wird dann immer sofort automatisch gestart, sobald ich die Datei vom Stick öffnen möchte ?

Gruß

Winfried

[Officer]

Nein, dazu musst Du das Makro bzw. den Aufruf in das Ereignis Workbook_Open() des Code-Containers "DieseArbeitsmappe" packen.
Damit wird der Code ausgeführt, sobald die Datei geöffnet wird.

Gruß

Alois

[Winfried]

alles klar Alois, ich danke dir !!!

[Fawiko]

Hallo zusammen,

über Google habe ich diesen Post gefunden, da ich genau nach dieser Lösung suche.
Nur ist das Problem, dass das was hier ausgelesen wird, NICHT die Seriennummer auf dem Controller ist. Es gibt ja einige Tools wie Deview, wo man diese SN auslesen kann. Aber diese stimmt schlichtweg nicht mit der, die aus dem Makro ausgelesen wird.

Könnt ihr mir/uns da helfen ?

LG

Fawiko

[Fawiko]

schade das nicht darauf reagiert wird, wenn ein Fehler gemacht wurde :-(

[maninweb]

Hallo,

schau' mal hier rein: http://www.myengineeringworld.net/2014/01/retrieve-usb-device-information-vba-wmi.html

Gruß