I'm trying to close the database after so much time in idle due to the amount of users wanting on the database. Here is a code I pulled from the Microsoft office website but there are some additions I would like to make. This code works fine but I would like it to have a message box after 5 minutes to say Yes or No to close the database. If the message box stays open and the user doesn't select either option, the database will wait another 3 minutes then close.
Here is what I have:
Private Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
' running the IdleTimeDetected subroutine.
Const IDLEMINUTES = 5
Static PrevControlName As String
Static PrevFormName As String
Static ExpiredTime
Dim ActiveFormName As String
Dim ActiveControlName As String
Dim ExpiredMinutes
On Error Resume Next
' Get the active form and control name.
ActiveFormName = Screen.ActiveForm.Name
If Err Then
ActiveFormName = "No Active Form"
Err = 0
End If
ActiveControlName = Screen.ActiveControl.Name
If Err Then
ActiveControlName = "No Active Control"
Err = 0
End If
' Record the current active names and reset ExpiredTime if:
' 1. They have not been recorded yet (code is running
' for the first time).
' 2. The previous names are different than the current ones
' (the user has done something different during the timer
' interval).
If (PrevControlName = "") Or (PrevFormName = "") Or (ActiveFormName <> PrevFormName) Or _ (ActiveControlName <> PrevControlName) Then
PrevControlName = ActiveControlName
PrevFormName = ActiveFormName
ExpiredTime = 0
Else
' ...otherwise the user was idle during the time interval, so
' increment the total expired time.
ExpiredTime = ExpiredTime + Me.TimerInterval
End If
' Does the total expired time exceed the IDLEMINUTES?
ExpiredMinutes = (ExpiredTime / 1000) / 60
If ExpiredMinutes >= IDLEMINUTES Then
' ...if so, then reset the expired time to zero...
ExpiredTime = 0
' ...and call the IdleTimeDetected subroutine.
IdleTimeDetected ExpiredMinutes
End If
End Sub
This is the call sub below. This has the message box saying no activity. I want this message box changed into a option Yes or No. If Yes or no isn't selected else it will close.
Sub IdleTimeDetected(ExpiredMi
nutes)
Dim Msg As String
Msg = "No user activity detected in the last "
Msg = Msg & ExpiredMinutes & " minute(s)!"
MsgBox Msg, 48
End Sub
Start Free Trial