Projektanfrage

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 Unter-stü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
   
     Programmierung
Excel Auftragsprogrammierung Access Auftragsprogrammierung
Word Auftragsprogrammierung Outlook Auftragsprogrammierung
   
   

Projektanfrage

 Sie benötigen eine Auftragsprogrammierung?
 Oder suchen Unterstützung bei der Lösungs-
 findung?

  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
   

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.

   

Relevante Artikel

  • Zellinformationen per Funktion auslesen

    112019 Diese Funktion liest verschiedene Zellinformationen aus und zeigt diese an.Public Function zellinfo(zelle As Range, i As Integer)Select Case iCase 1    zellinfo = zelle.AddressCase 2    zellinfo = zelle.ValueCase 3    zellinfo = zelle.FormulaLocalCase 4    If zelle.HasFormula = True Then        zellinfo = "Formel"    ElseIf IsNumeric(zelle) Then        zellinfo = "Zahl"    Else: zellinfo = "Text"    End IfCase Else    zellinfo = "nicht vergeben"End SelectEnd FunctionDie Funktion rufen Sie wie folgt auf:=zellinfo(zelle;paramter) Folgende...

  • Gelöschte Elemente aus PivotTable Auswahl entfernen

    Ein bekanntes Problem im Zusammenhang mit PivotTables ist die Tatsache, dass Einträge die aus der Quelldatei für die PivotTable gelöscht wurden, weiterhin im Auswahlfeld der PivotTable vorhanden...

  • Fortschrittsbalken in Statusleiste anzeigen

    Wenn es mal wieder etwas länger dauert, ist es sinnvoll, wenn der Anwender darüber informiert wird. Dies kann beispielsweise über eine kleine Anzeige in der Statusleiste unterhalb des Tabellenblatts erfolgen. In...

  • Sonderzeichen aus String entfernen

    In diesem Beitrag stellen wir eine Möglichkeit vor, um Sonderzeichen aus einer beliebigen Zeichenfolge zu entfernen.  Es handelt sich um eine Funktion, welche die definieren Sonderzeichen aus dem...

  • Verwendung von API Bibliotheken in Office 2010/2013 32bit und 64bit Versionen

    Per VBA können API-Bibliotheken relativ einfach eingebunden werden. Bei einer API (Application Programming Interface) handelt es sich um DLL- oder EXE-Dateien die eine Schnittstelle zum...