micky500970
Programmer
Hi i am desperately trying to unlock our DB when nobody is using it. At least unlock it at a certain time, say >7pm so I can safely back it up.
Despite telling staff they still persist on going home and leaving themselves logged into the network and leaving the DB open.
I found a thread on this forum and cannot get it to work. I do not think the timer is kicking in or something.I would be very gratefull if somebody could try it out.
many thanks in advance
Mick
Step 1-
-Create a form named DetectIdleTime
-Place this code in the form's On Timer event...
Private Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
' running the IdleTimeDetected subroutine.
Const IDLEMINUTES = 15
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
Sub IdleTimeDetected(ExpiredMinutes)
'Dim Msg As String
'Msg = "No user activity detected in the last "
'Msg = Msg & ExpiredMinutes & " minute(s)!"
'MsgBox Msg, 48
DoCmd.OpenForm "frm_ExitNonUse"
End Sub
I have the Timer Interval at 5000 which means the form checks the control status every 5 seconds and sends a warning after 15 minutes idle time. Feel free to change this to what best suits your application. Once this form detects that idle time has been reached, it launches a warning form...
Step 2-
-Create a new form named frm_ExitNonUse. Insert a Label field on the form with the following message in large bold red font on yellow form background...a real attention getter if you know what I mean..."This application will automatically close in 5 minutes due to non-use. To reset timer, simply close this form."
-Insert a command button labelled "OK" named cmdOK and place this code in the button's On Click event procedure
Private Sub cmdOK_Click()
On Error GoTo Err_cmdOK_Click
DoCmd.Close
Exit_cmdOK_Click:
Exit Sub
Err_cmdOK_Click:
MsgBox Err.Description
Resume Exit_cmdOK_Click
End Sub
-Set this form's Timer Interval to 5000 to again every 5 seconds check the active control.
-Place this code in the On Timer event procedure...
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
Sub IdleTimeDetected(ExpiredMinutes)
'Dim Msg As String
'Msg = "No user activity detected in the last "
'Msg = Msg & ExpiredMinutes & " minute(s)!"
'MsgBox Msg, 48
Application.Quit acSaveYes
End Sub
Step 4-
-Create a macro named AutoExec(this will automatically execute when the database is open) with the following properties...
Action - Select "OpenForm"
Form Name - enter "DetectIdleTime" without quotes
View - Form
Data Mode - Edit
Window Mode - Hidden
Despite telling staff they still persist on going home and leaving themselves logged into the network and leaving the DB open.
I found a thread on this forum and cannot get it to work. I do not think the timer is kicking in or something.I would be very gratefull if somebody could try it out.
many thanks in advance
Mick
Step 1-
-Create a form named DetectIdleTime
-Place this code in the form's On Timer event...
Private Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
' running the IdleTimeDetected subroutine.
Const IDLEMINUTES = 15
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
Sub IdleTimeDetected(ExpiredMinutes)
'Dim Msg As String
'Msg = "No user activity detected in the last "
'Msg = Msg & ExpiredMinutes & " minute(s)!"
'MsgBox Msg, 48
DoCmd.OpenForm "frm_ExitNonUse"
End Sub
I have the Timer Interval at 5000 which means the form checks the control status every 5 seconds and sends a warning after 15 minutes idle time. Feel free to change this to what best suits your application. Once this form detects that idle time has been reached, it launches a warning form...
Step 2-
-Create a new form named frm_ExitNonUse. Insert a Label field on the form with the following message in large bold red font on yellow form background...a real attention getter if you know what I mean..."This application will automatically close in 5 minutes due to non-use. To reset timer, simply close this form."
-Insert a command button labelled "OK" named cmdOK and place this code in the button's On Click event procedure
Private Sub cmdOK_Click()
On Error GoTo Err_cmdOK_Click
DoCmd.Close
Exit_cmdOK_Click:
Exit Sub
Err_cmdOK_Click:
MsgBox Err.Description
Resume Exit_cmdOK_Click
End Sub
-Set this form's Timer Interval to 5000 to again every 5 seconds check the active control.
-Place this code in the On Timer event procedure...
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
Sub IdleTimeDetected(ExpiredMinutes)
'Dim Msg As String
'Msg = "No user activity detected in the last "
'Msg = Msg & ExpiredMinutes & " minute(s)!"
'MsgBox Msg, 48
Application.Quit acSaveYes
End Sub
Step 4-
-Create a macro named AutoExec(this will automatically execute when the database is open) with the following properties...
Action - Select "OpenForm"
Form Name - enter "DetectIdleTime" without quotes
View - Form
Data Mode - Edit
Window Mode - Hidden
