Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: Winfried am Februar 06, 2014, 15:05:06 Nachmittag

Titel: Seriennummerabfrage auf USB-Stick
Beitrag von: Winfried am Februar 06, 2014, 15:05:06 Nachmittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Herbert Grom am Februar 07, 2014, 08:40:57 Vormittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Winfried am Februar 07, 2014, 10:21:23 Vormittag
Hallo Herbert,

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

Gruß

Winfried
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Winfried am Februar 07, 2014, 10:23:37 Vormittag
hab doch noch eine Frage, wo müßte ich jetzt zbs. die von mir vorgegebene Seriennummer 0815 eintragen ?
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Herbert Grom am Februar 07, 2014, 11:54:47 Vormittag
Ich weiß ja nicht, was Du damit machen willst! Vielleicht könntest Du mir mal Dein Vorhaben komplett schildern!
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Winfried am Februar 07, 2014, 12:09:17 Nachmittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Officer am Februar 07, 2014, 12:37:46 Nachmittag
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 (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]
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Herbert Grom am Februar 07, 2014, 13:27:18 Nachmittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Winfried am Februar 07, 2014, 13:40:29 Nachmittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Officer am Februar 07, 2014, 16:20:18 Nachmittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Winfried am Februar 07, 2014, 16:44:36 Nachmittag
alles klar Alois, ich danke dir !!!
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Fawiko am Januar 16, 2018, 08:53:28 Vormittag
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
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: Fawiko am Januar 19, 2018, 08:00:20 Vormittag
schade das nicht darauf reagiert wird, wenn ein Fehler gemacht wurde :-(
Titel: Antw: Seriennummerabfrage auf USB-Stick
Beitrag von: maninweb am Januar 19, 2018, 09:50:36 Vormittag
Hallo,

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

Gruß