R
Ryan
I use the following script to open an Access Database which has an autoexec macro that runs many reports and exports them out to specific servers for user access. On certain days of the week when network traffic is heavy the database takes 10 minutes or more to complete all of the tasks that have been coded into it. Excel comes back with an error that it is waiting for a job to complete which causes no other Excel Scripts to run until you click ok and the database completes it's functions. Is there a timeout setting within Excel Visual Basic that can be disabled in order to stop this message from Appearing?
Sub CorpLoad()
If (VarError = 0) And (Sheets("Email Running").Cells(9, 1) = Date) And (Sheets("Email Running").Cells(9, 2) = "") Then
' Initialize string to database path.
Const strConPathToSamples = "\\uscles611\purchdata\DATABASE\"
strDB = strConPathToSamples & "CORP.mdb"
' Create new instance of Microsoft Access
Set AppAccess = _
CreateObject("Access.Application")
' Open database in Microsoft Access window.
AppAccess.OpenCurrentDatabase strDB
DoEvents
AppAccess.Quit
Sheets("Email Running").Cells(17, 1) = Date
Sheets("Email Running").Cells(17, 2) = ""
ActiveWorkbook.Save
Name "\\uscles611\PURCHDATA\QUARKAPPS\APPS\PURCH_AP\XCOMDATA\POFILE.TXT" As "\\uscles611\PURCHDATA\QUARKAPPS\APPS\PURCH_AP\XCOMDATA\OLDPO\" & Format(Date, "mmdd") & ".TXT"
Else
Sheets("Email Running").Cells(17, 1) = Date
Sheets("Email Running").Cells(17, 2) = "POFILE.TXT file not created"
End If
End Sub
Sub CorpLoad()
If (VarError = 0) And (Sheets("Email Running").Cells(9, 1) = Date) And (Sheets("Email Running").Cells(9, 2) = "") Then
' Initialize string to database path.
Const strConPathToSamples = "\\uscles611\purchdata\DATABASE\"
strDB = strConPathToSamples & "CORP.mdb"
' Create new instance of Microsoft Access
Set AppAccess = _
CreateObject("Access.Application")
' Open database in Microsoft Access window.
AppAccess.OpenCurrentDatabase strDB
DoEvents
AppAccess.Quit
Sheets("Email Running").Cells(17, 1) = Date
Sheets("Email Running").Cells(17, 2) = ""
ActiveWorkbook.Save
Name "\\uscles611\PURCHDATA\QUARKAPPS\APPS\PURCH_AP\XCOMDATA\POFILE.TXT" As "\\uscles611\PURCHDATA\QUARKAPPS\APPS\PURCH_AP\XCOMDATA\OLDPO\" & Format(Date, "mmdd") & ".TXT"
Else
Sheets("Email Running").Cells(17, 1) = Date
Sheets("Email Running").Cells(17, 2) = "POFILE.TXT file not created"
End If
End Sub