• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Adding Expiration Date and Days Left to Expire Problem

Newmord

New Member
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:
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?
 

Attachments

  • REPORT.xlsm
    109.2 KB · Views: 8
It's misinterpreting your exdate. Try feeding as a serial with day, month, year explicitly called out.
Code:
exdate = DateSerial(2018, 12, 10)
Overall, you might change to this
Code:
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
 
Can I have a way to stop the counter if the System Clock is backdated to earlier date?

Thanks in advance
 
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))


Code:
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
 
Back
Top