Help with Auto Close VBA

TBC

Registered User.
Local time
Today, 14:24
Joined
Dec 6, 2010
Messages
145
I have code that will pop up a message on someone else computer when I change the trigger. The problem is that it should also do a count down and after 3 minutes close who ever has the database open.

I’m using Code A in the properties for a form “frmSwitchboard” in the “On Timer” and set the Timer Interval to 60000

Im using Code B in form “On Timer” frmAppShutdownWarn Timer Interval to 8000

Everything works except the timer to close the database automatically after 3 minutes

Code A in form frmSwitchboard
Code:
 Option Compare Database
Code:
[FONT=Times New Roman][SIZE=3]Private Sub Form_Open(Cancel As Integer)[/SIZE][/FONT]
 
[SIZE=3][FONT=Times New Roman]  [COLOR=red]' Set Count Down variable to false[/COLOR][/FONT][/SIZE]
[COLOR=red][SIZE=3][FONT=Times New Roman]   ' on the initial opening of the form.[/FONT][/SIZE][/COLOR]
[SIZE=3][FONT=Times New Roman]   boolCountDown = False[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   Dim strFileName As String[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   strFileName = Dir("[COLOR=#3366ff]\\us.bank-dns.com\mspmetro\mn157h\blhm\CORRLEND\DataHold\Enabled.db[/COLOR]")[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   If strFileName <> "Enabled.db" Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       MsgBox "Database being updated, please try again later."[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       Application.Quit acQuitSaveAll[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   End If[/FONT][/SIZE]
 
[FONT=Times New Roman][SIZE=3]End Sub[/SIZE][/FONT]
 
[FONT=Times New Roman][SIZE=3]Private Sub Form_Timer()[/SIZE][/FONT]
 
[FONT=Times New Roman][SIZE=3]On Error GoTo Err_Form_Timer[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]   Dim strFileName As String[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   strFileName = Dir("[COLOR=#3366ff]\\us.bank-dns.com\mspmetro\mn157h\blhm\CORRLEND\DataHold\Enabled.db[/COLOR]")[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   If boolCountDown = False Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    [COLOR=red]  ' Do nothing unless the check file is missing.[/COLOR][/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       If strFileName <> "Enabled.db" Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]          [COLOR=red]' The check file is not found so[/COLOR][/FONT][/SIZE]
[COLOR=red][SIZE=3][FONT=Times New Roman]           ' set the count down variable to true and[/FONT][/SIZE][/COLOR]
[COLOR=red][SIZE=3][FONT=Times New Roman]           ' number of minutes until this session[/FONT][/SIZE][/COLOR]
[COLOR=red][SIZE=3][FONT=Times New Roman]           ' of Access will be shut down.[/FONT][/SIZE][/COLOR]
[SIZE=3][FONT=Times New Roman]           boolCountDown = True[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]           intCountDownMinutes = 3[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]           GoTo Warningform[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   Else[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    [COLOR=red]  ' Count down variable is true so warn[/COLOR][/FONT][/SIZE]
[COLOR=red][SIZE=3][FONT=Times New Roman]       ' the user that the application will be shut down[/FONT][/SIZE][/COLOR]
[COLOR=red][SIZE=3][FONT=Times New Roman]       ' in X number of minutes.  The number of minutes[/FONT][/SIZE][/COLOR]
[COLOR=red][SIZE=3][FONT=Times New Roman]       ' will be 1 less than the initial value of the[/FONT][/SIZE][/COLOR]
[COLOR=red][SIZE=3][FONT=Times New Roman]       ' intCountDownMinutes variable because the form timer[/FONT][/SIZE][/COLOR]
[COLOR=red][SIZE=3][FONT=Times New Roman]       ' event is set to fire every 60 seconds[/FONT][/SIZE][/COLOR]
[SIZE=3][FONT=Times New Roman]       intCountDownMinutes = intCountDownMinutes - 1[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]Warningform:[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]       DoCmd.OpenForm "frmAppShutDownWarn"[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       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."[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       If intCountDownMinutes < 1 Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]          [COLOR=red]' Shut down Access if the countdown is zero,[/COLOR][/FONT][/SIZE]
[COLOR=red][SIZE=3][FONT=Times New Roman]           ' saving all work by default.[/FONT][/SIZE][/COLOR]
[SIZE=3][FONT=Times New Roman]           Application.Quit acQuitSaveAll[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]       End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   End If[/FONT][/SIZE]
 
[FONT=Times New Roman][SIZE=3]Exit_Form_Timer:[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]   Exit Sub[/FONT][/SIZE]
 
[FONT=Times New Roman][SIZE=3]Err_Form_Timer:[/SIZE][/FONT]

Code B in form: frmAppShutdownWarn within On Timer
Code:
 Option Compare Database[/SIZE][/FONT]
 
[FONT=Times New Roman][SIZE=3]Private Sub Form_Timer()[/SIZE][/FONT]
 
[FONT=Times New Roman][SIZE=3]If Text2 = "1" Then[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]   Me.Detail.BackColor = 65535[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   Text2 = "2"[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]Else[/SIZE][/FONT]
[SIZE=3][FONT=Times New Roman]   Me.Detail.BackColor = 255[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]   Text2 = "1"[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]End If[/SIZE][/FONT]
 
[FONT=Times New Roman][SIZE=3]End Sub[/SIZE][/FONT]
 
The only real issue I see is if you pop a MsgBox to a user who is not at his/her desk then no code will execute until they hit OK. MsgBox is a blocking operation and no other code will run in the current MS app while one is showing. Instead of opening a MsgBox use a form with a large label or the like, set a timer event in that form so after the 3 minutes are up it closes the DB.
 
The messagebox is in the form open event rather than the timer so it's a fair assumption that someone will still be at the PC after opening the database.

But you are correct, and inputboxes or msgboxes will effectively pause the access window and stop and code which comes after it.
 

Users who are viewing this thread

Back
Top Bottom