Auftragsprogrammierung

Projektanfrage über Web Formular   per Online-Formular 
Projektanfrage über E-Mail  Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein!
Projektanfrage per Telefon  +49 (0)151 / 164 55 914
Projektanfrage weitere Informationen  weitere Informationen 

Sie benötigen Hilfe oder Unterstützung? Nutzen Sie für Ihre Anfrage unser Online-Formular, senden Sie uns eine Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein!  oder rufen Sie uns einfach an.

Referenzen

 Bosch 
  T-Systems
  Hagebau
  Siemens
 Areva  VW
 Haufe-Lexware  British American Tobacco
  nagel group farbe

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.

Drucken E-Mail

Relevante Artikel

  • Übersicht aller Excel Schlüsselwörter

    Nachfolgend eine Übersicht aller VBA-Schlüsselwörter in Deutsch und Englisch.  Deutsch = Abs - Englisch = Abs Deutsch = AktiviereAnw - Englisch =...

  • Tastencodes für die Funktion OnKey()

    Möchten Sie bspw. das Makro "Test_Makro" über die Tastenkombination [Strg] + [t] starten, dann können Sie dies mit dem OnKey-Befehl per VBA...

  • UserName ermitteln

    Dieses Makro liest den UserName (Benutzernamen) des eingeloggten Benutzers aus. Dies ist für Dateien/Programme interessant, die nur für bestimmte...

  • Markierte Zellen summieren

    Mit dieser Prozedur, werden alle markierten Zellen summiert. Dabei wird geprüft, ob die einzelnen Zellen eine Zahl enthalten. Nur dann wird die...

  • Textzeichen aus Zellen entfernen (nur Ziffen auslesen)

    Mit dem folgenden Beispiel-VBA Code werden aus beliebigen Zellen alle Text-Zeichen außer Zahlen entfernt. Dies kann nach einem Datenimport notwendig...

Projektanfrage

 Sie benötigen eine Auftragsprogrammierung?
 Oder suchen Unterstützung bei der 
 Lösungsfindung?

  Nutzen Sie unser Anfrageformular

  Jetzt anrufen unter 0151 / 164 55 914

 Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein! Projektanfrage per Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein! senden

  Weitere Informationen

sitepanel question2

P
R
O
J
E
K
T
A
N
F
R
A
G
E
Cookies erleichtern die Bereitstellung unserer Dienste. Mit der Bestätigung erklären Sie sich mit der Verwendung von Cookies auf Excel-Inside Solutions einverstanden.
Weitere Informationen Ok