Laufzeitgrenze mit Countdown u. Registryeintrag

Sub DatumsCheck()
Dim ersterAufruf As Date
If GetSetting("TEST", "Einstellungen", "ErsterAufruf") = "31.12.9999" Then Exit Sub
If GetSetting("TEST", "Einstellungen", "ErsterAufruf") = "" Then
'setzen des Datums
SaveSetting "TEST", "Einstellungen", "ErsterAufruf", Format(Date, "dd.mm.yyyy")
End If
'Check ob noch Gültig
ersterAufruf = GetSetting("TEST", "Einstellungen", "ErsterAufruf")
MsgBox "Der erste Aufruf war am " & ersterAufruf
If DateDiff("d", DateValue(ersterAufruf), Date) > 30 Then
If Application.InputBox("Der Testzeitraum ist vorbei!" & vbLf _
& "Geben Sie den Productkey ein, den Sie " & vbLf _
& "bei Kollege/in XYZ für dieses Programm erhalten," & vbLf _
& "in das vorgesehene Feld ein, dann können Sie" & vbLf _
& "das Programm unbegrenzt verwenden" & vbLf _
& "Productkey Eingabe Kollege XYZ") = "TEST" Then
SaveSetting "TEST", "Einstellungen", "ErsterAufruf", "31.12.9999"
Else
ThisWorkbook.Saved = True
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End If
Else
MsgBox "Sie haben noch " & 30 - DateDiff("d", DateValue(ersterAufruf), Date) & " Tage   _
_
zum Testen!"
End If
End Sub

Es wird in die Registry der erste Aufruf geschrieben. Wenn nach Ablauf von 30 Tagen das Programm gestartet wird muss man das Passwort (im Bsp TEST) eingeben dann ist es unbegrenzt lauffähig.
Vorstehenden Code habe hier von einem freundlichen Forumsmitglied bekommen. Das mit dem Registry-Eintrag ist toll, selbst wenn die Mappe umbenannt wird, kommt die Meldung, wie oft man die Mappe noch benutzen kann.
Es stört mich aber, dass die Mappe nach Passworteingabe unbegrenzt lauffähig ist. Dies möchte ich ändern, durch den zusätzlichen Countdown. Das mit dem Registry-Eintrag soll aber bleiben!
Ich hoffe, mich verständlich ausgedrückt zu haben.
Vielen Dank an die Helferlein
und Gruß: Konni