none
Error message in module when I set the MS Access 2010 database to expire RRS feed

  • Question

  • Hello All,

    I created a module and added the VBA code below:

    Option Compare Database
    Option Explicit
    Public Function ExpiredDate()
    On Error GoTo ErrHandler:
    Dim Msg, Style, Title, Help, Ctxt, DBErr, MyString
    If (Date > #1/1/2017#) Then
    Msg = "End of free period, Please contact developer"
        Style = vbOKCancel + vbCritical
        Title = "Critical Database Error"
        DBErr = MsgBox(Msg, Style, Title, Help, Ctxt)
    If DBErr = vbOK Then
    Application.Quit
    Exit Function
    End If
    If DBErr = vbCancel Then
    Dim strPasswd As String
    Dim counter As Integer
    Dim Remaining As Integer
    counter = 0
    Do Until counter = 3
    strPasswd = InputBox("Please Enter Password", "Password Required")
    'If a correct password is entered, open a SwitchBoard Form
    'If incorrect password or no password entered then shows a message
    'for 3 times to re-enter a password then exit program
    If strPasswd = "0" Then
    Else
    counter = counter + 1
    Remaining = 3 - counter
    MsgBox "Wrong password or Incorrect password!" & vbCrLf & _
    "You have " & Remaining & " attempt(s) remaining!", _
    vbOKOnly, "Password Info"
    End If
    Loop
    Application.Quit
    Exit Function
    End If
    End If
    Exit_ErrHandler:
    Exit Function
    ErrHandler:
    MsgBox Err.Description, vbCritical
    Err.Clear
    End Function

    I call the function on the On Load Event Procedure on the form called the SwitchBoard Form: -

    Option Compare Database Option Explicit Private Sub Form_Load() Call ExpiredDate End Sub

    I took the necessary precaution to make a copy of my database and save the copy on my desktop. Once I open the SwitchBoard, I received a message that the database has expired: "End of free period, Please contact developer", followed by a pop-up dialog box with the message "The command or action 'Quit' isn't available now". After I click the "Ok" button, the database shuts down and it does not reopen. How to fix this problem with the "Quit isn't available now" and once fixed, will the three tries to enter a password work?



    • Edited by wirejp Monday, January 22, 2018 5:12 AM
    Monday, January 22, 2018 5:10 AM

Answers

  • I tested your code and it worked just fine for me.  I'd make some very minor changes, but it work fine as is so I suspect your issue is coming from somewhere else.  Perhaps some unload, close event...

    Public Function ExpiredDate()
        On Error GoTo ErrHandler
        Dim Msg                   As String
        Dim Style
        Dim Title                 As String
        Dim DBErr                 As Integer
        Dim strPasswd             As String
        Dim counter               As Integer
        Dim Remaining             As Integer
    
        If (Date > #1/1/2017#) Then
            Msg = "End of free period, Please contact developer"
            Style = vbOKCancel + vbCritical
            Title = "Critical Database Error"
            DBErr = MsgBox(Msg, Style, Title)
            If DBErr = vbOK Then
                Application.Quit
                Exit Function
            ElseIf DBErr = vbCancel Then
                counter = 0
                Do Until counter = 3
                    strPasswd = InputBox("Please Enter Password", "Password Required")
                    'If a correct password is entered, open a SwitchBoard Form
                    'If incorrect password or no password entered then shows a message
                    'for 3 times to re-enter a password then exit program
                    If strPasswd = "0" Then
                    Else
                        counter = counter + 1
                        Remaining = 3 - counter
                        MsgBox "Wrong password or Incorrect password!" & vbCrLf & _
                               "You have " & Remaining & " attempt(s) remaining!", _
                               vbOKOnly, "Password Info"
                    End If
                Loop
                Application.Quit
                Exit Function
            End If
        End If
    
    Exit_ErrHandler:
        Exit Function
    
    ErrHandler:
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: ExpiredDate" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
        Resume Exit_ErrHandler
    End Function

    I'd urge you to use a naming convention and add more informative error handling (as illustrative above).


    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net

    • Marked as answer by wirejp Monday, January 22, 2018 6:27 PM
    Monday, January 22, 2018 12:10 PM

All replies

  • I tested your code and it worked just fine for me.  I'd make some very minor changes, but it work fine as is so I suspect your issue is coming from somewhere else.  Perhaps some unload, close event...

    Public Function ExpiredDate()
        On Error GoTo ErrHandler
        Dim Msg                   As String
        Dim Style
        Dim Title                 As String
        Dim DBErr                 As Integer
        Dim strPasswd             As String
        Dim counter               As Integer
        Dim Remaining             As Integer
    
        If (Date > #1/1/2017#) Then
            Msg = "End of free period, Please contact developer"
            Style = vbOKCancel + vbCritical
            Title = "Critical Database Error"
            DBErr = MsgBox(Msg, Style, Title)
            If DBErr = vbOK Then
                Application.Quit
                Exit Function
            ElseIf DBErr = vbCancel Then
                counter = 0
                Do Until counter = 3
                    strPasswd = InputBox("Please Enter Password", "Password Required")
                    'If a correct password is entered, open a SwitchBoard Form
                    'If incorrect password or no password entered then shows a message
                    'for 3 times to re-enter a password then exit program
                    If strPasswd = "0" Then
                    Else
                        counter = counter + 1
                        Remaining = 3 - counter
                        MsgBox "Wrong password or Incorrect password!" & vbCrLf & _
                               "You have " & Remaining & " attempt(s) remaining!", _
                               vbOKOnly, "Password Info"
                    End If
                Loop
                Application.Quit
                Exit Function
            End If
        End If
    
    Exit_ErrHandler:
        Exit Function
    
    ErrHandler:
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: ExpiredDate" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
        Resume Exit_ErrHandler
    End Function

    I'd urge you to use a naming convention and add more informative error handling (as illustrative above).


    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net

    • Marked as answer by wirejp Monday, January 22, 2018 6:27 PM
    Monday, January 22, 2018 12:10 PM
  • Hi Daniel,

    Thank you for the feedback. I made the changes which you have provided. When I open the frmSwitchBoard, I receive the error message:

    An Error has Occurred!

    Error Number: 2046

    Error Source: ExpiredDate

    Error Description: The command or action 'Quit' isn't available now.

    Monday, January 22, 2018 12:55 PM
  • I can't replicate the issue. It always works fine for me.

    Does your VBA project compile without errors?
    Have you Compacted your database?
    Is your Office installation fully updated?
    Are you using the full version of Access or the runtime version?

    Can you post a copy of your database for us to review (removing any sensitive data first!)?


    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net


    Monday, January 22, 2018 1:39 PM
  • Hi Daniel,

    I think I picked up on something causing the issue In the frmSwitchBoard, there was a gap space between the Option Explicit and the first line of code below. When I deleted out the space, the error message disappeared. I tested the application two more times, and the error occurred again.

    Option Compare Database
    Option Explicit
    
    Private Sub Form_Load()
    Call ExpiredDate
    End Sub

    My VBA code compile without errors.

    I have compacted/repaired my database.

    My office installation is fully updated.

    I am using the full version of Access 2010.



    • Edited by wirejp Monday, January 22, 2018 6:28 PM
    Monday, January 22, 2018 2:42 PM
  • I get no error after multiple tests?!

    Check your task manager and make sure you don't have any hidden msaccess.exe processes running that you aren't aware of.


    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net


    Monday, January 22, 2018 3:11 PM