Endlosschleife im Makro, komme nicht raus
27.06.2007 09:01:02
Claudia
mit nachstehendem Makro, habe ich mal von Hajo erhalten, kann ich mittels Freischaltcode eine im Registrieungs-Editor gesetzte 30 Tage Demo unbegrenzt freischalten. Das klappt auch super (wenn der Code richtig ist), nur habe ich jetzt versucht, das mann beim freischalten mehrmals den Code eingeben darf, falls man sich vertippt hat. Allerdings ist das jetzt eine Endlosschleife und ich komme nicht mehr aus dem Programm heraus.
Was muss am Ende geändert werden, das das Programm nach z.B. dreimaligen falschen Code sich speichert evtl. ein Hinweis ersheint und sich schließt. Ich hoffe das das verständlich ist.
Private Sub freischalten()
Dim ersterAufruf As Date
If GetSetting("unterlagen", "Einstellungen", "ErsterAufruf") = "31.12.9999" Then Exit Sub
If GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf") = "" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", Format(Date, "dd.mm.yyyy")
End If
ersterAufruf = GetSetting("unterlagen ", "Einstellungen", "ErsterAufruf")
If InputBox("Vielen Dank für Ihre Teilnahme." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Geben Sie bitte den Code ein, den Sie von uns" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "erhalten haben, in das freie Feld ein." _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Achten Sie bitte auf Groß- und Kleinschreibung" _
& Chr(10) & Chr(13) & "" _
& Chr(10) & Chr(13) & "Productkey Eingabe des Teilnehmers") = "test" Then
SaveSetting " unterlagen ", "Einstellungen", "ErsterAufruf", "31.12.9999"
Else
MsgBox "Die Eingabe ist nicht richtig." & vbLf _
& "Versuchen Sie es erneut indem Sie den Code eingeben." & vbLf _
& "Falls Sie Probleme haben, senden Sie uns eine E-Mail."
ThisWorkbook.Saved = True
If Workbooks.Count = 1 Then GoTo Fehlerb
End If
Fehlerb:
Application.Run "freischalten"
End Sub
Vielen Dank für Eure Hilfe
Gruß
Claudia