Adding Expiration Date and Days Left to Expire Problem

[Newmord]

I am new in VBA, please help.
I am using a workbook with set expire date. which runs behind userform at initiation
I have a workbook with userform which runs the workbook behind the userform when initializing.

I am tying to to add expiration date and days left for expiration to the workbook with this code:

Private Sub Workbook_Open()
    Application.Visible = False
    LoginForm.Show

    Dim exdate As Date
    exdate = Format("10/12/2018", "DD/MM/YYYY")
    If Date > exdate Then
MsgBox "Sorry! Evaluation period of the utility has expired." & vbCrLf & _
            "Please consult the Administrator.", vbCritical, "Outdated/Expired Version"
    mbox = Application.InputBox("Pls enter the password/code to continue...", "Password")
    End If
        If mbox <> "ABC" Then
        Application.Visible = False
    End If
    MsgBox ("You have " & exdate - Date & "Days left") 
    Application.Visible = True
    End If
End Sub

My problems are;
1. When the expiration date is not due message box appears already but it still terminates the application.
2. When I turn off the Application.Visible = False under the mbox <> "ABC" Then, then the application will not terminate even if the password is false.

Attached is the sample file
Login details to the attached file
USERNAME: user
PASSWORD: 1234
EXPIRED PASSWORD: ABC

Any help please?

 

[Luke M]

It's misinterpreting your exdate. Try feeding as a serial with day, month, year explicitly called out.

exdate = DateSerial(2018, 12, 10)

Overall, you might change to this

Private Sub Workbook_Open()
    Dim exDate As Date
    Dim mBox As String
   
    Application.Visible = False
    LoginForm.Show
   
    exDate = DateSerial(2018, 12, 10)
    If Date > exDate Then
        MsgBox "Sorry! Evaluation period of the utility has expired." & vbCrLf & _
                    "Please consult the Administrator.", vbCritical, "Outdated/Expired Version"
        ThisWorkbook.Close savechanges:=False
    End If
   
PassInput:
    mBox = ""
    mBox = Application.InputBox("Pls enter the password/code to continue...", "Password")
    If mBox = "" Then
        'User aborted, close
        ThisWorkbook.Close savechanges:=False
    ElseIf mBox = "ABC" Then
        MsgBox ("You have " & exDate - Date & "Days left")
        Application.Visible = True
    Else
        MsgBox "Invalid password. Please try again"
        GoTo PassInput
    End If
End Sub

 

[Deepak]

Pls check.

 

[Newmord]

Thank you all!!!
it really helped

 

[Newmord]

Can I have a way to stop the counter if the System Clock is backdated to earlier date?

Thanks in advance

 

[Deepak]

Hi,

Pls check it and fell free ask if any issue occurred.

To check it without manually changing system date just remove Int from here Int(FileDateTime(Me.FullName))

Private Sub Workbook_Open()
Dim exdate As Date, mbox As String

Application.Visible = False
'-------------------------------------------------------------------------------------------------------
'Choose anyone as per need!
'Close the file if current date is behind last excel saved.
    If Date < Int(FileDateTime(Me.FullName)) Then
        MsgBox "System Date has been changed!", vbCritical, "Access Denied"
          ' .Close 0 'option one
          GoTo Alert ' option two/ choose where to go after it
    End If
'-------------------------------------------------------------------------------------------------------
ExCheck:
    exdate = DateSerial(2018, 12, 4)
 
    If Date > exdate Then
        MsgBox "Sorry! Evaluation period of the utility has expired." & vbCrLf & _
            "Please consult the Administrator.", vbCritical, "Outdated/Expired Version"
    Else
        GoTo Login
    End If

PassInput:
    mbox = ""
    mbox = Application.InputBox("Pls enter the password/code to continue...", "Password")

    If mbox = "" Then
        'User aborted, close
      Me.Close savechanges:=False
    ElseIf mbox = "ABC" Then
    Else
        MsgBox "Invalid password. Please try again.", vbCritical, "Error"
        GoTo PassInput
    End If
   
Login:
    LoginForm.Show

Alert:
MsgBox "You have " & CStr(Application.Max(0, exdate - Date)) & " Days left.", vbInformation
Application.Visible = True

End Sub