Limit Password attempts

[Av8tordude]

I have a code the requires user to enter a password when prompted, but i like to limit the user from attempting to enter a password to "x" amount of times.

I search the board and was NOT able to find anything. Can you Help.

 

[unmarkedhelicopter]

Put it in a loop count the number of times in the loop then kick em out after X attempts.
This means that they would then have to close and reopen the worksheet to re-attempt.
This may be an option to them but ... if you put a timer in the loop open a form that is modal and has no controls saying "Password Incorrect, you must wait 1 minute before another attempt" then close the form after a minute, and allow the loop to continue.

 

[Av8tordude]

Put it in a loop count the number of times in the loop then kick em out after X attempts.
This means that they would then have to close and reopen the worksheet to re-attempt.
This may be an option to them but ... if you put a timer in the loop open a form that is modal and has no controls saying "Password Incorrect, you must wait 1 minute before another attempt" then close the form after a minute, and allow the loop to continue.

Thanks for the information, but I have limited experience with VBA. Forgive me if it comes across as being rude, as this in not my sincere intentions, but I've search these boards and can't seem to get help on this topic in the form a code or offer a link to get me pointed in the right direction to self-assist myself in solving this problem on my own.

Its very frustrating.

Once again, thank you for responding and forgive me if I am being rude. Can you offer a code or a link that I can self-assist myself in solving this dilemma?

 

[Jonmo1]

Post the code you have that prompts for a password. We can help modify it to do a limited # of loops...

 

[VoG]

Something like

Sub GetPW()
Dim userResponse As Variant, i As Byte, pw As String
pw = "password"
For i = 1 To 3
    userResponse = InputBox("Enter password")
    i = i + 1
    If userResponse = pw Then Exit For
Next i
If userResponse <> pw Then
    MsgBox "Wrong password"
    Exit Sub
Else
    MsgBox "Password OK"
End If
End Sub

 

[Av8tordude]

Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#
 
Const TrialPeriod# = 1 '< 1 days trial
 
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "LBFileLog.Log"
 
If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then
Close #1
Exit Sub
Else
If [A1] <> "Expired" Then
Call MsgBox("This book is expired. Please enter the password to continue", vbCritical, "EXPIRED!")
Resp = InputBox("This book is expired. Please enter the password to continue")
If Resp = "password" Then
Exit Sub
Else: Application.Quit
End If
End If
End If
End If
End Sub

 

[Av8tordude]

Something like

Sub GetPW()
Dim userResponse As Variant, i As Byte, pw As String
pw = "password"
For i = 1 To 3
    userResponse = InputBox("Enter password")
    i = i + 1
    If userResponse = pw Then Exit For
Next i
If userResponse <> pw Then
    MsgBox "Wrong password"
    Exit Sub
Else
    MsgBox "Password OK"
End If
End Sub

Thank you kindly for your help. It points me into the direction needed to solving my dilemma

 

[Av8tordude]

Is there a way to implement with this code to allow the user to enter a password to allow permanent access to the workbook and not be prompted for a password again?

The code that I have allows for a trial period, when the trial period has expired the user is required to purchase a password to allow unrestricted access to the workbook. The only problem I'm facing is the when I enter the password and close it and open it again, I'm prompted for a password again.

The other thing, i read many threads as to how Excel is so unsecure. I'm trying to create a code to offer the user a trial version with an expire date. After the expired date, purchase a password for unrestricted access. if the user does not buy the password and trys to gain illegal unrestricted access, the killme code will delete the workbook.

the user will have "x" amount of trys to enter the correct password, be provide each time a warning of expiration and to purchase a password for unlimited use.

 

[Smitty]

Is there a way to implement with this code to allow the user to enter a password to allow permanent access to the workbook and not be prompted for a password again?

The code that I have allows for a trial period, when the trial period has expired the user is required to purchase a password to allow unrestricted access to the workbook. The only problem I'm facing is the when I enter the password and close it and open it again, I'm prompted for a password again.

The other thing, i read many threads as to how Excel is so unsecure. I'm trying to create a code to offer the user a trial version with an expire date. After the expired date, purchase a password for unrestricted access. if the user does not buy the password and trys to gain illegal unrestricted access, the killme code will delete the workbook.

the user will have "x" amount of trys to enter the correct password, be provide each time a warning of expiration and to purchase a password for unlimited use.

In order to do something like that you need to log the access attempts, either in a hidden text file or a hidden sheet/obscure cell. Then have your code refer to the count.

HTH,

Smitty

 

[Av8tordude]

In order to do something like that you need to log the access attempts, either in a hidden text file or a hidden sheet/obscure cell. Then have your code refer to the count.

HTH,

Smitty

Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#
Const TrialPeriod# = 1 '< 1 days trial
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "LBFileLog.Log"

If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then
Close #1
Exit Sub
Else
Call MsgBox("This Workbook Has Expired. Please Enter Password To Continue", vbCritical, "EXPIRED!")
Dim userResponse As Variant, i As Byte, pw As String
pw = "password"
For i = 1 To 3
userResponse = InputBox("Enter password")
i = i + 0
If userResponse = pw Then Exit For
Next i
If userResponse <> pw Then
Call MsgBox("Wrong password, The Workbook Will Not be Deleted", vbCritical, "")
ThisWorkbook.Close SaveChanges:=False
Exit Sub
End If
End If
End If
End Sub


Actually my code has that, and I have the kill me code to input into the code, but not sure how to go about implementing a way to warn the user they only have "x" amount of time to enter the correct password before the workbook is deleted. Also, how do I go about giving the user unrestricted access to the workbook after purchasing the password and not be prompted for a password again.