PDA

View Full Version : [SOLVED] Compare dates - password required if expired



Allen
12-22-2017, 03:02 AM
Hi Guys,

I've taken this from youtube and there are several issues:banghead::


Even if date is greater - popup will appear
Password won't loop
If I change date to 2016, I can hit ESC or enter twice and still get in.



Private Sub Workbook_Open()
Dim d1 As Date
Dim d2 As Date
Dim password As String
d1 = DateSerial(2018, 12, 31)
d2 = Date
If d2 > d1 Then
password = InputBox("enter password")
Else
MsgBox ("Opening file")
End If
If password = "abc123" Then
MsgBox ("Welcome!")
Else
MsgBox ("Incorrect password!")
password = InputBox("enter password again")
End If
End Sub

I would like this to work but can't figure out how:doh:.
Would be grateful if someone can help me solve this.

Many Thanks

Al

Dave
12-22-2017, 06:38 AM
HTH. Dave

Private Sub Workbook_Open()
Dim d1 As Date
Dim d2 As Date, Cnt As Integer
Dim password As String
d1 = DateSerial(2018, 12, 31)
d2 = Date
If d2 > d1 Then
above:
password = InputBox("enter password")
If password = "abc123" Then
MsgBox ("Welcome!")
Else
MsgBox ("Incorrect password!")
Cnt = Cnt + 1
'3 trials of password input
If Cnt < 3 Then
GoTo above
Else
MsgBox "ACCESS DENIED"
Application.Quit
End If
End If
Else
MsgBox ("Opening file")
End If
End Sub

Paul_Hossler
12-22-2017, 08:59 AM
I added CODE tags to your post - see my sig for the way to do it

1. This could be a lot more polished (polished a lot more?)

2. Not sure of what your flow is, but might give you some ideas





Option Explicit
Private Const pwGood As String = "abc123"
Private Const dateCheck As Date = #12/31/2016# '<<<<<<<<<<<<<<<<<<<<<<<< changed for testing

Private Sub Workbook_Open()
Dim pwEntered As String
Dim pwTries As Long
If Date > dateCheck Then

pwTries = 2
pwEntered = InputBox("enter password")

Do While pwEntered <> pwGood And pwTries > 0
MsgBox ("Incorrect password!")
pwEntered = InputBox("enter password again")
pwTries = pwTries - 1
Loop

If pwTries = 0 Then
MsgBox "Too bad"
ThisWorkbook.Saved = True
' Application.Quit ' <<<<<<<<<<<<<<<<<<<<<<<< commented out for testing
Else
MsgBox ("Opening file")
End If
End If
End Sub

SamT
12-22-2017, 09:32 AM
Option Explicit

Private Sub Workbook_Open()
Dim Attempts As Long 'Attempts = 0 ATT

If Date > #12/31/2018# Then
Do While Attempts < 3 '3 = Max Number of tries
Attempts = Attempts + 1 'Set to actual number of this attempt
If InputBox("enter password", "Password Required") = "abc123" Then
Exit Sub 'Good PW
Else
MsgBox "Bad Password, PLease try again."
End If
Loop

'If here, then good Password not entered
MsgBox "You failed to enter the correct Password. THis Workbook will now close"
Me.Saved = True 'Prevents Alerts on Close
Me.Close
End If
End Sub

MINCUS1308
12-22-2017, 11:07 AM
HAHAHA Dave
application.quit

:rotlaugh:

Allen
01-02-2018, 01:48 AM
Thanks