CODEWITHSUNDEEP
vbams-access
Carly Dewdney
Carly Dewdney

Reputation: 33

Using buttons in a pop up that auto closes access to log users out

I have a pop up that comes up after a user has been inactive for x amount of time. I can get the message box to come up and close my database after 30 seconds, however I would like to use a vbcancel button to allow the user to reset the timer.

I've managed to either get the program to shut after 30 seconds OR get the vbcancel button to work, but not both in conjunction - so i tried a loop. However i don't think i'm doing it correctly?

Public Property Get oMsgBox() As Object
    Set oMsgBox = CreateObject("WScript.Shell")
End Property

Private Function IdleTimeDetected(ExpiredMinutes)
    'oMsgBox.PopUp "Testing...closing in ten seconds.", 10, "Force Closed", vbInformation
    oMsgBox.PopUp "No user activity detected in the last " & ExpiredMinutes & " minute(s)! Your copy of the Master Database will be closed in thirty seconds.", 30, "Force Close", vbCancel + vbInformation

    Static ExpiredTime

    Dim t As Date, tStop As Date
    t = Now
    tStop = t + TimeValue("00:00:30") 'Adjust the TimeValue as needed "hh:mm:ss"


    Do Until t = tStop

        DoEvents

        Dim LResponse As Integer
        LResponse = oMsgBox.PopUp("No user activity detected in the last " & ExpiredMinutes & " minute(s)! Your copy of the Master Database will be closed in thirty seconds.", 30, "Force Close", vbOKCancel + vbInformation)

        If LResponse = vbCancel Then
           ExpiredTime = 0

        t = Now
    Loop

    DoCmd.RunCommand acCmdExit

    End Function

Currently I get a message saying

The expression ON Timer you entered as the event property setting produces the following error

Loop without do.

Upvotes: 0

Views: 41

Answers (1)

Carly Dewdney
Carly Dewdney

Reputation: 33

Thanks 4dmonster,

I took your advise and spotted my issue, then discovered a few more - like multiple message boxes and the database being closed regardless of which button you clicked so the form needed to be reset to restart the clocks.

I think i have ironed out the kinks! 

Private Function IdleTimeDetected(ExpiredMinutes)
'oMsgBox.PopUp "Testing...closing in ten seconds.", 10, "Force Closed", vbInformation
Const IDLEMINUTES = 1
Static ExpiredTime

Dim LResponse As Integer
LResponse = oMsgBox.PopUp("No user activity detected in the last " & ExpiredMinutes & " minute(s)! Your copy of the Master Database will be closed in thirty seconds.", 30, "Force Close", vbOKCancel + vbInformation)

Dim t As Date, tStop As Date
t = Now
tStop = t + TimeValue("00:00:29") 'Adjust the TimeValue as needed "hh:mm:ss"


Do Until t = tStop

DoEvents
If LResponse = vbOK Then
DoCmd.RunCommand acCmdExit
Else
If LResponse = vbCancel Then
   ExpiredTime = 0
   DoCmd.OpenForm "DetectIdleTime", acDesign, , , , acHidden
End If
End If

t = Now

Loop

 ExpiredMinutes = (ExpiredTime / 1000) / 60
     If ExpiredMinutes >= IDLEMINUTES Then
DoCmd.RunCommand acCmdExit
End If
End Function

Upvotes: 1

Related Questions