Makro kann nur von einem bestimmten USB-Stick aus gestartet werden

In diesem Beitrag zeige ich Ihnen einen Möglichkeit, wie sichergestellt werden kann, dass ein Makro nur von einem bestimmten USB-Stick aus gestartet werden kann.

Dazu wird die Seriennummer des USB-Sticks ausgelesen und mit der im VBA-Code hinterlegten Seriennummer verglichen. Der eigentliche Programmcode wird entsprechend nur ausgeführt, wenn die im Code hinterlegte Seriennummer mit der aktuell  ausgelesenen Seriennummer übereinstimmt. In alllen anderen Fällen wird das Programm mit einer Hinweismeldung beendet.

Kopieren Sie bitte den folgenden VBA-Code in ein Modulblatt und starten Sie die Prozedur USB_ID_auslesen.

'** Berechtigte Seriennummer festlegen
Const id = 682590861

Sub USB_ID_auslesen()
'** Dimensionierung der Variablen
Dim objFSO, objLaufwerk, strLaufwerk As String, USB_ID$

'** Vorgaben festlegen
Set objFSO = CreateObject("Scripting.FileSystemObject")

'** Errorhandling
On Error GoTo ende

'** Seriennumemr auslesen
For Each objLaufwerk In objFSO.Drives
  If objLaufwerk.IsReady Then
    If objLaufwerk.DriveType = "1" Then USB_ID = objLaufwerk.SerialNumber
  End If
Next objLaufwerk
   
If USB_ID = id Then
  '** Wenn Seriennummer übereinstimmt - weitere Prozeduren ausführen
  Weiterer_Code
Else
  '** Wenn Seriennummer nicht übereinstimmt - Abbrechen
  MsgBox "Das Programm wird nicht weiter ausgeführt, da es sich um keinen gültigen USB-Stick handelt.", _
    vbCritical, "Hinweis"
End If

'** Programmende
ende:
   Set objFSO = Nothing
End Sub

In der ersten Programmzeile "Const id = 682590861" befindet sich die Seriennummer, die für eine gültige Programmausführung erwartet wird. Nur wenn die später im Programm ausgelesene USB_ID mit der angegebenen id übereinstimmt, wird das eigentliche VBA-Programm ausgeführt.

Der folgende VBA-Code enthält dann das eigentliche Makro, welches nur dann ausgeführt wird, wenn die Seriennummern übereinstimmen.

Sub Weiterer_Code()

'** Dieser Code wird nur dann ausgeführt, wenn die Seriennummer des USB-Sticks
'** mit der angegebenen Seriennummer übereinstimmt
MsgBox "Der Code wird ausgeführt!"

End Sub

Damit die Seriennummer im Programm hinterlegt werden kann, muss diese zuerst einmal ausgelesen werden. Dazu gibt es verschiedene kostenlose Tools wie beispielsweise das Programm List USB Drives. Alternativ kann aber auch der leicht abgewandelte VBA-Code verwendet werden, der die Seriennummer in einer Message-Box ausgibt, siehe Listing:

Sub USB_ID_einmalig_auslesen()
'** Dimensionierung der Variablen
Dim objFSO, objLaufwerk, strLaufwerk As String, USB_ID$

'** Vorgaben festlegen
Set objFSO = CreateObject("Scripting.FileSystemObject")

'** Errorhandling
On Error GoTo ende

'** Seriennumemr auslesen
For Each objLaufwerk In objFSO.Drives
  If objLaufwerk.IsReady Then
    If objLaufwerk.DriveType = "1" Then USB_ID = objLaufwerk.SerialNumber
  End If
Next objLaufwerk
   
'** Seriennummer auslesen
MsgBox "Die Seriennummer des USB-Sticks lautet wie folgt: " & USB_ID

'** Programmende
ende:
   Set objFSO = Nothing
End Sub

Die Beispieldatei können Sie über den folgenden Link herunterladen.