My frmMainForm opens frminactiveshutdown as follows:
DoCmd.OpenForm "frmInactiveShutDown", , , , , acHidden
and below is all the code from frmInActiveShutDown:
Option Compare Database
Option Explicit
' frmInactiveShutDown v2.0 for MS Access from Peter's Software
'
' Copyright: Peter's Software 2001-2004 ::
http://www.peterssoftware.com
'
' Description:
' A form that monitors user activity and automatically shuts down the
application after
' a specified period of inactivity.
'
' This module was created by:
'
' Peter's Software
' 10540 National Blvd #21
' Los Angeles, CA 90034
' USA
' (e-mail address removed)
'
http://www.peterssoftware.com
'
' This form and associated code are distributed as freeware
'
' Usage
'
' Import the form frmInactiveShutDown into your application and open it
hidden at application startup.
'
' Set the inactivity period by adjusting values in the form OnOpen event
procedure.
'
' Optionally include the basISDOptionalModule to take advantage of a
global variable that is set
' to True when an Inactive Timeout occurs.
'
'* Set this constant to True if you want the ISD form to pop up in front of
other
'* application windows when an Inactive Timeout occurs.
Const conPopUpISDFormForeground = True
Const conSeconndsPerMinute = 60
Dim sngStartTime As Single
Dim ctlSave As Control
Dim intMinutesUntilShutDown As Integer
Dim intMinutesWarningAppears As Integer
Private Const SW_RESTORE = 9
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
Private Declare Function SetForegroundWindow& Lib "USER32" (ByVal hWnd As
Long)
Private Declare Function IsIconic Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "USER32" (ByVal hWnd As Long, ByVal
nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "USER32" (ByVal hWnd As Long,
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As
Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Function xg_CallIfPresent(pstrFunctionNameAndParms As String) As
Integer
'* Call a function using the Eval function.
'* This method allows us to call a function whether it exists or not.
'*
'* Returns
'* 1 - Function found, executed, and returns True
'* 2 - Function found, executed, and returns False
'* 3 - Function not found
'* 99 - Other error
Dim intRtn As Integer
On Error Resume Next
If Eval(pstrFunctionNameAndParms) Then
If err <> 0 Then
Select Case err
Case 2425, 2426
intRtn = 3 '* The function is not found
Case Else
MsgBox "Error in xg_CallIfPresent when calling '" &
pstrFunctionNameAndParms & "': " & err.Number & " - " & err.Description
intRtn = 99 '* Other error
End Select
err.Clear
Else
intRtn = 1 '* Function evaluates to True
End If
Else
intRtn = 2 '* Function evaluates to False
End If
Exit_Section:
On Error Resume Next
xg_CallIfPresent = intRtn
On Error GoTo 0
Exit Function
Err_Section:
Beep
MsgBox "Error in xg_CallIfPresent: " & err.Number & " - " &
err.Description
err.Clear
Resume Exit_Section
End Function
Private Sub Form_Close()
On Error Resume Next
ctlSave = Nothing
err.Clear
On Error GoTo 0
End Sub
Private Sub Form_Open(CANCEL As Integer)
'* Set this variable to the number of minutes of inactivity
'* allowed before the application automatically shuts down.
intMinutesUntilShutDown = 30
'* Set this variable to the number of minutes that the
'* warning form will appear before the application
'* automatically shuts down.
intMinutesWarningAppears = 1
Me.Visible = False
sngStartTime = Timer
End Sub
Private Sub Form_Timer()
'**********************************************************************
'* This timer event procedure will shut down the application
'* after a specified number of minutes of inactivity. Inactivity
'* is measured based on how long a control remains the ActiveControl.
'**********************************************************************
Dim sngElapsedTime As Single
Dim ctlNew As Control
Dim i As Integer
On Error Resume Next
Set ctlNew = Screen.ActiveControl
If err <> 0 Then
'* No activecontrol
sngElapsedTime = Timer - sngStartTime
err.Clear
Else
If ctlNew.name = "InactiveShutDownCancel" Then
'* The warning form has appeared, and the cancel button
'* is the active control
sngElapsedTime = Timer - sngStartTime
Else
If ctlNew.name = ctlSave.name Then
'* Still at same control
sngElapsedTime = Timer - sngStartTime
Else
'* Some change has occured, we're at a new control
Set ctlSave = ctlNew
sngStartTime = Timer
End If
If err <> 0 Then
Set ctlSave = Screen.ActiveControl
End If
End If
End If
err.Clear
Set ctlNew = Nothing
Select Case sngElapsedTime
Case Is > (intMinutesUntilShutDown * conSeconndsPerMinute)
'* Set global timeout variable, then shut down each form
'* This code can be used if there is code in the form's BeforeUpdate,
'* or OnClose event procedure that requires user input.
'* The variable "gintInactiveTimeout" can be checked in the form events
'* and can be used to prevent the user prompt code from executing.
Dim frm As Form
'* Set the global variable "gintInactiveTimeout" to True if the
basISDOptionalModule is included
Select Case xg_CallIfPresent("isd_SetInactiveTimeoutVar(True)")
Case 1, 2, 3, 99
'* We'll accept the results regardless of the return code
Case Else
End Select
For Each frm In Forms
DoCmd.Close acForm, frm.name, acSaveYes
Next frm
'* Set the global variable "gintInactiveTimeout" to False if the
basISDOptionalModule is included
Select Case xg_CallIfPresent("isd_SetInactiveTimeoutVar(False)")
Case 1, 2, 3, 99
'* We'll accept the results regardless of the return code
Case Else
End Select
Set frm = Nothing
Set ctlSave = Nothing
DoCmd.Quit acQuitSaveAll
Case Is > ((intMinutesUntilShutDown - intMinutesWarningAppears) *
conSeconndsPerMinute)
'* Make the warning form visible if it is not already visible.
If Me.Visible Then
Else
Me.Visible = True
If conPopUpISDFormForeground Then
'* Un-minimize Access application if it is minimized
If IsIconic(Application.hWndAccessApp) Then
ShowWindow Application.hWndAccessApp, SW_RESTORE
End If
'* Make it the foreground window - open it in front of other
application windows.
SetForegroundWindow (Me.hWnd)
End If
'* Open it on top of other modal windows.
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or
SWP_NOSIZE Or SWP_SHOWWINDOW
End If
Case Else
'* The next line can be commented out if the form is opened hidden
'Me.Visible = False
End Select
Exit_Section:
End Sub
Private Sub InactiveShutDownCancel_Click()
sngStartTime = Timer
Me.Visible = False
End Sub
