Laufwerksbuchstaben auslesen und Seriennummer prüf

Hallo Forum,
ist es möglich per VBA in einem Rutsch alle Laufwerke mit Seriennummer auszulesen?
Laufwerksbuchstaben kriege ich (mit Hilfe der Recherche) hin. Die Seriennummer eines Laufwerkes auch.
Ich möchte folgendes erreichen:
VBA soll prüfen ob ein USB-Stick mit einer bestimmten Seriennummer vorhanden ist. Wenn ja, dann soll die Arbeitsmappe geöffnet werden können, wenn nicht, wird der Zugriff auf diese Mappe verhindert.
(Soll als Koperschutz dienen. Da ich z.Zt. die zu bestückenden Rechner alle bei mir habe, könnte ich es auch mit der Seriennummer von Laufwerk "C" lösen / klappt auch schon). Ich möchte meine Arbeitsmappe aber nach Möglichkeit an einen von mir zur Verfügung gestellten USB-Stick knüpfen, da ja die Hardware auch mal ausfallen kann). "Wer den USB-Stick hat kann mit der Arbeitsmappe arbeiten, sonst ist die Mappe gesperrt".
(Ja, ich weiß. Jeder Schutz läßt sich umgehen, aber das wäre für mich mal einen Versuch wert.
Bin für jeden Tipp dankbar.
Gruß
Dieter.K

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Horst,
Du hast natürlich recht, "alles läßt sich knacken".
Da ich die VBA-Projekteigenschaften jedoch unter Excel-XP setze, ist das "knacken" jedoch schon nicht mehr so einfach wie unter Excel 8.0.
Es geht mir auch nur darum, eine kleine Sperre einzubauen. Wenn ich die Seriennummer der Festplatte nutze, kommt ja erst einmal niemand auf die Idee, daß die Datei damit einen Kopierschutz hat (wie gesagt: die zu benutzenden Rechner stehen im Augenblick bei mir. Wenn jedoch einer dieser Rechner ausgetauscht wird, habe ich keinen Zugriff mehr.) In der Datei (Kalkulationen und statische Berechnungen aus dem Stahlbau) könnte ich sicher noch weitere Funktionen einbauen (z.B. wenn das VBA Passwort geknackt wird und man feststellt, daß eine Seriennummer ausgelesen wird, könnte man diese Nummer ändern. Wenn aber in einer weiteren Zelle die Nummer ein weiteres mal abgeglichen wird, wäre es möglich in diesem Fall nur wenige vorhandene Formeln zu löschen oder zu verändern. Damit wird zumindest der Aufwand noch schwieriger an die Daten zu kommen.)
Hast Du eine Idee, wie ich einen USB Laufwerksbuchstaben ermitteln kann? Ich habe 2 Sticks. Beide werden (wenn einzelnd gesteckt) mit unterschiedlichen Buchstaben erkannt. Einer mit i und der andere mit j, egal welche USB-Buchse ich nutze.
Gruß
Dieter.K

Private Sub Workbook_Open() Dim fs Dim Laufwerk Set fs = CreateObject("Scripting.filesystemobject") On Error Resume Next For Each Laufwerk In fs.drives Worksheets("Tabelle1").Range("A2").Value = Laufwerk.SerialNumber Next If Worksheets("Tabelle1").Range("A2").Value = Worksheets("Tabelle1").Range("A3").Value Then Exit Sub Else ThisWorkbook.Close False End If End Sub

Beliebteste Forumthreads (12 Monate)

Laufwerksbuchstaben auslesen und Seriennummer prüf

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread