[/FONT][/COLOR][FONT=Times New Roman][SIZE=3] [/SIZE][/FONT][COLOR=black][FONT=Verdana]Else[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' Count down variable is true so warn[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' the user that the application will be shut down[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' in X number of minutes. The number of minutes[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' will be 1 less than the initial value of the[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' intCountDownMinutes variable because the form timer[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' event is set to fire every 60 seconds[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] intCountDownMinutes = intCountDownMinutes - 1[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Warningform:[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] DoCmd.OpenForm "frmAppShutDownWarn"[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Forms!frmAppShutDownWarn!txtWarning = "Please save all work and close the database ASAP."[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] If intCountDownMinutes < 1 Then[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' Shut down Access if the countdown is zero,[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' saving all work by default.[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Application.Quit acQuitSaveAll[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Exit_Form_Timer:[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Exit Sub[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Err_Form_Timer:[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Resume Next[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End Sub
If intCountDownMinutes < 1 Then
[COLOR=black][FONT=Verdana] ' Shut down Access if the countdown is zero,[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] ' saving all work by default.[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Application.Quit acQuitSaveAll[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] End If[/FONT][/COLOR]
Code is all on the switchboard (Timer interval 60000):
Code:Private Sub Form_Open(Cancel As Integer) ' Set Count Down variable to false ' on the initial opening of the form. boolCountDown = False Dim strFileName As String strFileName = Dir("[URL="file://\\Fillgpet03a005\D_credrisk0001$\Staff"]\\Fillgpet03a005\D_credrisk0001$\Staff[/URL] Database\Archive\Enabled.db") If strFileName <> "Enabled.db" Then MsgBox "Database being updated, please try again later. Application.Quit acQuitSaveAll End If End Sub Private Sub Form_Timer() On Error GoTo Err_Form_Timer Dim strFileName As String strFileName = Dir("[URL="file://\\Fillgpet03a005\D_credrisk0001$\Staff"]\\Fillgpet03a005\D_credrisk0001$\Staff[/URL] Database\Archive\Enabled.db") If boolCountDown = False Then ' Do nothing unless the check file is missing. If strFileName <> "Enabled.db" Then ' The check file is not found so ' set the count down variable to true and ' number of minutes until this session ' of Access will be shut down. boolCountDown = True intCountDownMinutes = 3 GoTo Warningform End If Else ' Count down variable is true so warn ' the user that the application will be shut down ' in X number of minutes. The number of minutes ' will be 1 less than the initial value of the ' intCountDownMinutes variable because the form timer ' event is set to fire every 60 seconds [B] intCountDownMinutes = intCountDownMinutes - 1[/B] Warningform: DoCmd.OpenForm "frmAppShutDownWarn" Forms!frmAppShutDownWarn!txtWarning = "Due to database maintenance this application will automatically shut down in approximately " & intCountDownMinutes & " minute(s). Please save all work and close the database ASAP." If intCountDownMinutes < 1 Then ' Shut down Access if the countdown is zero, ' saving all work by default. Application.Quit acQuitSaveAll End If End If Exit_Form_Timer: Exit Sub Err_Form_Timer: Resume Next End Sub
The filepath & name will obviouslly need to be changed, you will also need a form called "frmAppShutDownWarn" with a textbox control called "txtWarning".
Personally I also have a timer event on the warning form with an interval of 800 (and a hidden textbox called "Text2"):
Code:Private Sub Form_Timer() If Text2 = "1" Then Me.Detail.BackColor = 65535 Text2 = "2" Else Me.Detail.BackColor = 255 Text2 = "1" End If End Sub
This causes the warning message to flash between 2 bright colours to ensure it's noticed.
The downside of timer events is they only work when Access is ready. If it's displaying a messagebox or an inputbox, etc then the timer event will not fire and the database will remain open for that user (although the event will start it's 3 min countdown when Access becomes ready if the filename differs).
msgbox "If statement 1 true"
Option Explicit
Dim boolCountDown As Boolean
Dim intCountDownMinutes As Integer
Private Sub Form_Open(Cancel As Integer)
' Set Count Down variable to false
' on the initial opening of the form.
boolCountDown = False
Dim strFileName As String
strFileName = Dir("C:\Documents and Settings\dspalla\Desktop\enabled.db")
If strFileName <> "Enabled.db" Then
MsgBox "Database being updated, please try again later."
Application.Quit acQuitSaveAll
End If
End Sub
Private Sub Form_Timer()
On Error GoTo Err_Form_Timer
Dim strFileName As String
strFileName = Dir("C:\Documents and Settings\dspalla\Desktop\enabled.db")
If boolCountDown = False Then
' Do nothing unless the check file is missing.
If strFileName <> "enabled.db" Then
' The check file is not found so
' set the count down variable to true and
' number of minutes until this session
' of Access will be shut down.
boolCountDown = True
intCountDownMinutes = 3
End If
Else
' Count down variable is true so warn
' the user that the application will be shut down
' in X number of minutes. The number of minutes
' will be 1 less than the initial value of the
' intCountDownMinutes variable because the form timer
' event is set to fire every 60 seconds
intCountDownMinutes = intCountDownMinutes - 1
DoCmd.OpenForm "frmAppShutDownWarn"
Forms!frmAppShutDownWarn!txtWarning = "This application will be shut down in approximately " & intCountDownMinutes & " minute(s). Please save all work and exit immediately."
If intCountDownMinutes < 1 Then
' Shut down Access if the countdown is zero,
' saving all work by default.
Application.Quit acQuitSaveAll
End If
End If
Exit_Form_Timer:
Exit Sub
Err_Form_Timer:
Resume Next
End Sub