Do not get me wrong. I do not have any problem to show you the code. I will
as a matter of fact. But you are right I can make the application quit when
ever there is an error. So it means that every procedure must have an error
catcher and instaed of invoquing the message box I just enter the application
quit command.
But does it mean that VBA does not have a way to end a task or end a
database that the User will like to kill it for what ever reason?.
Here goes the codes
Private Sub Form_Timer()
On Error GoTo ErrUpdate
Dim sgUpdateTime As Single, sgIntervalTime As Single
Dim stUpdateTime As String, stIndicator As String, stACCESSExeFile As
String, _
stApplicationPathName As String, stFlagFilePathName As String
Dim iCycle As Integer
'Time frequency in which this procedure runs
sgIntervalTime = Me.TimerInterval / 1000 ' TimerInterval is milliseconds
and 'sgIntervalTime' is converted to seconds
'Set variable for MS Access executable file
stACCESSExeFile = DFirst("[MSAccessExeFile]",
"[tblApplicationInformationHolder]")
iCycle = 1
GoTo SkipCodeLine ' skip next block of codes to get variable values on
'Select Case' statement
RepeatLine:
pblProcessingLevel = 2001 ' for error tracking purposes
'Set path and file name of the dummy file used by the lauched databases
to update themselves
stFlagFilePathName = DFirst("[FlagFilePathName]",
"tblApplicationGlobalUpdateTimes", "[Indicator] = """ & stIndicator & """")
pblProcessingLevel = 2002 ' for error tracking purposes
'Define the time the corresponding applications are to be opened
sgUpdateTime = (CSng(DFirst(stUpdateTime,
"tblApplicationGlobalUpdateTimes", "[Indicator] = """ & stIndicator & """")))
* 3600
pblProcessingLevel = 2003 ' for error tracking purposes
'If true, Time is within 'sgUpdateTime' and '(sgUpdateTime +
sgIntervalTime)'
If Timer >= sgUpdateTime And Timer <= sgUpdateTime + sgIntervalTime Then
' code Q If
pblProcessingLevel = 2004 ' for error tracking purposes
'Create a dummy file using 'tblApplicationRevison' as a source. The
dummy file is used by the database to update itself
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"tblApplicationRevison", stFlagFilePathName
pblProcessingLevel = 2005 ' for error tracking purposes
'Set path and file name of the database to be opened
stApplicationPathName = DFirst("[FilePath]",
"tblApplicationGlobalUpdateTimes", "[Indicator] = """ & stIndicator & """") _
& DFirst("[FileName]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """")
pblProcessingLevel = 2006 ' for error tracking purposes
'True, the share drive 'S' may not be available
If Dir(stApplicationPathName) = "" Then GoTo ExitErrUpdate
pblProcessingLevel = 2007 ' for error tracking purposes
'Open MS ACCESS and then the database
Shell stACCESSExeFile & " " & stApplicationPathName, 3
'Exiting the sub ensures that any update will be at least
'sgIntervalTime' minutes apart
GoTo ExitErrUpdate ' the next round for update check will be within
'sgIntervalTime' minutes
End If ' code Q End If
SkipCodeLine:
Select Case iCycle
'UPDATE GEARS INVOICE
Case 1
pblProcessingLevel = 2007 ' for error tracking purposes
iCycle = 2: stUpdateTime = "[UpdateTime]": stIndicator =
"GearsInvoice"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
GoTo RepeatLine
'UPDATE MAIN TABLE APPLICATION
Case 2
pblProcessingLevel = 2008 ' for error tracking purposes
iCycle = 3: stUpdateTime = "[UpdateTime]": stIndicator =
"ApplicationMainTable"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
'True, it is Saturday or Sunday; therefore do not process it
If Weekday(Date, vbMonday) = 6 Or Weekday(Date, vbMonday) = 7
Then GoTo SkipCodeLine
GoTo RepeatLine
'UPDATE GPS ON TUESDAY
Case 3
pblProcessingLevel = 2010 ' for error tracking purposes
iCycle = 4: stUpdateTime = "[UpdateTime]": stIndicator =
"GPSTable"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
'True, it is Tuesday; therefore do process it
If Weekday(Date, vbMonday) = 2 Then GoTo RepeatLine
GoTo SkipCodeLine
'UPDATE GEARS MATERIAL
Case 4
pblProcessingLevel = 2011 ' for error tracking purposes
iCycle = 5: stUpdateTime = "[UpdateTime]": stIndicator =
"GearsMaterial"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
'True, it is Saturday or Sunday; therefore do not process it
If Weekday(Date, vbMonday) = 6 Or Weekday(Date, vbMonday) = 7
Then GoTo SkipCodeLine
GoTo RepeatLine
'UPDATE GEARS PLANNER
Case 5
pblProcessingLevel = 2012 ' for error tracking purposes
iCycle = 6: stUpdateTime = "[UpdateTime]": stIndicator =
"GearsPlanner"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
'True, it is Saturday or Sunday; therefore do not process it
If Weekday(Date, vbMonday) = 6 Or Weekday(Date, vbMonday) = 7
Then GoTo SkipCodeLine
GoTo RepeatLine
'RUN ORDER CURRENT WEEK PLUS PROCESS IN GEARS ORDER SPEC
(GearsOrderSpecProcessOne)
Case 6
pblProcessingLevel = 2013 ' for error tracking purposes
iCycle = 7: stUpdateTime = "[UpdateTime]": stIndicator =
"GearsOrderSpecProcessOne"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
'True, it is Saturday or Sunday; therefore do not process it
If Weekday(Date, vbMonday) = 6 Or Weekday(Date, vbMonday) = 7
Then GoTo SkipCodeLine
GoTo RepeatLine
'UPDATE MAIN PROCESS APPLICATION (ApplicationMainProcessOne)
Case 7 ' this process runs every day
pblProcessingLevel = 2014 ' for error tracking purposes
iCycle = 8: stUpdateTime = "[UpdateTime]": stIndicator =
"ApplicationMainProcessOne"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
GoTo RepeatLine
'UPDATE MAIN PROCESS APPLICATION (ApplicationMainProcessTwo)
Case 8 ' this process runs every day
pblProcessingLevel = 2015 ' for error tracking purposes
iCycle = 9: stUpdateTime = "[UpdateTime]": stIndicator =
"ApplicationMainProcessTwo"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
GoTo RepeatLine
'RUN ORDER LONG FORECAST PROCESS IN GEARS ORDER SPEC
(GearsOrderSpecProcessTwo)
Case 9
pblProcessingLevel = 2016 ' for error tracking purposes
iCycle = 10: stUpdateTime = "[UpdateTime]": stIndicator
= "GearsOrderSpecProcessTwo"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
'True, it is Saturday or Sunday; therefore do not process it
If Weekday(Date, vbMonday) = 6 Or Weekday(Date, vbMonday) = 7
Then GoTo SkipCodeLine
GoTo RepeatLine
'UPDATE MAIN PROCESS APPLICATION (ApplicationMainProcessThree)
Case 10 ' this process runs every day
pblProcessingLevel = 2017 ' for error tracking purposes
iCycle = 11: stUpdateTime = "[UpdateTime]": stIndicator
= "ApplicationMainProcessThree"
'True, this process is turn off; therefore do not process it
If DFirst("[ProcessFlag]", "tblApplicationGlobalUpdateTimes",
"[Indicator] = """ & stIndicator & """") = "NO" Then GoTo SkipCodeLine
GoTo RepeatLine
End Select
ExitErrUpdate:
Exit Sub
ErrUpdate:
'If true, record the error but does not display warning
If Err.Number = 52 Or Err.Number = 3043 Or Err.Number = 3024 Then
PROCESS_ERROR_STATUS Err.Number, Err.Description, "AutoUpdate", "OK"
Resume ExitErrUpdate
End If
PROCESS_ERROR_STATUS Err.Number, Err.Description, "AutoUpdate"
Resume ExitErrUpdate
End Sub
Klatuu said:
I know what you are trying to address.
What I was trying to determine is where you are now so I could offer a
suggestion.
One of my suggestions is you modify the applications to quit the application
rather than show a message box. Is there any reason you can't do that?
Another thing you might try is to go to this site:
http://www.mvps.org/access/api/index.html
And see if there are any API calls that will get it done for you.
--
Dave Hargis, Microsoft Access MVP
:
Changing the codes is not a problem, because I have a table that for every
application it records the line where the error occur and enters the error as
well. That is the way I know what to fix. Once I fix the problem in the
master database (the processing databases are front end databases) I would
like to replace the productive database with the corrected master database
but for that I need to have the one that is open with the error killed or
ended so I can replace it. I have access to the folders in the server to do
all this. To re-run the process I would go in the table and enter a new time
close to the current time so the main application lauches the corrected
database again for processing. This is why I need the codes to kill the error
database.
If you want I can post the codes for your information to see how I lauch the
databases, but that is not the problem I am trying to address
:
I got an email that someone has posted a reply, but nothing came through.
Thinking about it, the only plan I can come up with is to create a table in
the main application that will have fields to identify the app that had the
error.
Then in the applications the main app starts up, change the code so that
rather than presenting a message box, it writes a record in the table the
indicates it failed.
Now, in the time event of the main app. add code to check for errors in the
other apps. If it find an error record, delete the error record and start
the app up again.
--
Dave Hargis, Microsoft Access MVP
:
The main database is open constantly and via the OnTime event of the a form
every 5 minutes a rpcedure runs to checks the current time against the time
set up in a table for various applications. If they match with +/- 5 minutes
it open the corresponding application which automatically start the processing
:
How do I end an ACCESS database using VBA just like a User end the task using
the Task Manager. I only need to end a particular database, not the whole MS
ACCESS application.
