VBA for Date Expiry does not close WorkBook

[Defiant177]

Found the below solution on the Web at
https://www.datanumen.com/blogs/prot...nlicensed-use/

Option Explicit
Dim dteExpiry As Date ‘Declare variables
Dim flagLocked As String
Dim strPWD As String
Dim strResult As String

Sub Auto_open()
Sheets("Welcome").Visible = True
Sheets("Main").Visible = xlVeryHidden 'Can't be unhidden by the user
Sheets("Defaults").Visible = xlVeryHidden

dteExpiry = Sheets("Defaults").Range("B1") 'Test for Expiry
strPWD = Sheets("Defaults").Cells(2, 2)
flagLocked = Sheets("Defaults").Cells(3, 2)

If dteExpiry < Now() And flagLocked = "No" Then 'Trial period over
flagLocked = "Yes"
Sheets("Defaults").Cells(3, 2) = flagLocked
ActiveWorkbook.Save 'Ensures that flagLocked is set
MsgBox "The trial period has expired. Please contact xxxx at yyyyy"
ElseIf flagLocked = "Yes" Then
strResult = InputBox("Enter password", "Password", vbOKCancel)
If strResult = strPWD Then
Sheets("Main").Visible = True 'Reveal the "Main" sheet
Sheets("Welcome").Visible = False
Else
MsgBox "The password is wrong. Please contact xxxx at yyyyy"
Exit Sub
End If
Else ‘Within trial period
Sheets("Main").Visible = True
Sheets("Main").Activate
Sheets("Welcome").Visible = False
End If
End Sub

Sub Auto_Close()
Sheets("Welcome").Visible = True
Sheets("Main").Visible = xlVeryHidden
Sheets("Defaults").Visible = xlVeryHidden
ActiveWorkbook.Save
End Sub

Using EXCEL 2010 – with the code in Module 1
The workbook does not close if I enter an incorrect password(lockflag set to Yes).
It just stays open.
What am I doing wrong??

[Paul_Hossler]

I didn't see any place that actually closed the workbook

I added "Thisworkbook.Close False" below and it seems ok

Be advised that this can be easily circumvented




Option Explicit

Dim dteExpiry As Date 'Declare variables
Dim flagLocked As String
Dim strPWD As String
Dim strResult As String


Sub Auto_open()
Sheets("Welcome").Visible = True
Sheets("Main").Visible = xlVeryHidden 'Can't be unhidden by the user
Sheets("Defaults").Visible = xlVeryHidden

dteExpiry = Sheets("Defaults").Cells(1, 2).Value ' Test for Expiry
strPWD = Sheets("Defaults").Cells(2, 2).Value
flagLocked = Sheets("Defaults").Cells(3, 2).Value

If dteExpiry < Now() And flagLocked = "No" Then 'Trial period over
flagLocked = "Yes"
Sheets("Defaults").Cells(3, 2) = flagLocked
ActiveWorkbook.Save 'Ensures that flagLocked is set

MsgBox "The trial period has expired. Please contact xxxx at yyyyy"

ThisWorkbook.Close False
'Application.Quit

ElseIf flagLocked = "Yes" Then
strResult = InputBox("Enter password", "Password", vbOKCancel)

If strResult = strPWD Then
Sheets("Main").Visible = True 'Reveal the "Main" sheet
Sheets("Welcome").Visible = False
Else
MsgBox "The password is wrong. Please contact xxxx at yyyyy"

ThisWorkbook.Close False
'Application.Quit
End If

Else 'Within trial period
Sheets("Main").Visible = True
Sheets("Main").Select
Sheets("Welcome").Visible = False
End If
End Sub



Sub Auto_Close()
Sheets("Welcome").Visible = True
Sheets("Main").Visible = xlVeryHidden
Sheets("Defaults").Visible = xlVeryHidden
ActiveWorkbook.Save
End Sub