Mal schauen ob jemand draus kommt
Also hier den Code (Hauptteil):
Public Static Sub alles(was As Integer, b As String, p As String, y As String, z As String, Benutzer As String, Passwort As String, aB As String, aP As String, nB As String, nP As String, nPw As String)
Dim benu(1) As String
Dim pass(1) As String
Dim x As Integer
Dim benut As String, passw As String
'Welcher Fall
Select Case was
Case 1
GoTo uep
Case 2
GoTo hp
Case 3
GoTo loeschen
Case 4
GoTo ändern
End Select
'Passwort Erkennung
uep:
Dim i As Integer
Open "C:\Eigene Dateien\FLorian\VBA Tests\Pdataw.dat" For Random As 1 Len = 100
Get #1, 201, x
For i = 1 To x
Get #1, i, benut
Get #1, i + 100, passw
If benut = b And passw = p Then
FrmPass.Hide
Exit Sub
End If
Next i
Workbooks("Passwort.xls").Close
Close 1
Exit Sub
'Passwort und Benutzername dazufügen
hp:
Dim k As String * 12, l As String * 12
Open "C:\Eigene Dateien\FLorian\VBA Tests\Pdataw.dat" For Random As 1 Len = 100
k = y
l = z
Get #1, 201, x
x = x + 1
Put #1, 201, x
Put #1, x, k
Put #1, x + 100, l
Close 1
Exit Sub
'Benutzername löschen
loeschen:
Dim g As Integer, m As Integer, u As Integer
Open "C:\Eigene Dateien\FLorian\VBA Tests\Pdataw.dat" For Random As 1 Len = 100
Get #1, 201, x
For g = 1 To x
Get #1, g, benut
Get #1, g, passw
If benut = Benutzer And passw = Passwort Then
m = MsgBox("Wollen Sie wirklich ihr Benutzername Löschen?" + Chr(13) + "Wenn er gelöscht ist, wird sich die Arbeitsmappe automatisch schliessen." + Chr(13) + "Es werden keine Daten verloren gehen", 292, "Löschen?")
If m = 6 Then
x = x - 1
Put #1, 201, x
For u = g To (x - 1)
Get #1, u + 1, benut
Get #1, u + 101, passw
Put #1, u, benut
Put #1, u + 100, passw
Next u
Else
Exit Sub
End If
End If
Next g
m = MsgBox("Falscher Benutzername bzw. falsches Passwort.", , "Fehler ...")
Close 1
Exit Sub
'Benutzername bzw. Passwort ändern
ändern:
Dim e As Integer, q As Integer
Open "C:\Eigene Dateien\FLorian\VBA Tests\Pdataw.dat" For Random As 1 Len = 100
Get #1, 201, x
For e = 1 To x
Get #1, e, benut
Get #1, e + 100, passw
If benut = aB And passw = aP Then
If nP = nPw Then
Put #1, e, nB
Put #1, e + 100, nP
Close 1
Exit Sub
Else
q = MsgBox("Die Passwortwiederholung, des neuen Passwortes, ist falsch", , "Fehler ...")
Exit Sub
End If
End If
If e = x Then
q = MsgBox("Falscher Benutzername bzw. falsches Passwort.", 48, "Fehler ...")
End If
Next e
Close 1
Exit Sub
End Sub
Hinzufügen funktioniert. Aber irgendetwas stimmt mit der Überprüfung nicht, glaub ich.
Also am Anfang wenn die Mappe aufgerufen wird wird automatisch den Teil Passwort überprüfen aufgerufen. Ich geben das richtige Passwort ein aber es lässt mich trotzdem nicht rein als wäre es falsch. Beim Löschen oder beim ändern kommt ein Laufzeitenfehler '59'. Falsche Datensatzlänge. Wäre sehr dankbar wenn mir jemand helfen kann. Ich würde dem oder der das Programm auch schicken wenn es so nicht geht zum überprüfen.
Grüssli
