Multiple MS Access Databases + Outlook (VBA) hanging during scheduled task run - vba

Question

I have created several MS Access databases that connect to my company's SQL server (MSSQL), perform calculations, then export the results in the form of email. These are set up to run through the windows task scheduler at a certain time of the day. Before you ask, I do not have access to the SQL server so I cannot create any stored procedures or do anything other than read. These run on a desktop computer under my desk which is on 100% of the time (other than a weekly reboot).
The issue I am having is with using VBA in MS Access to actually send the emails. All of the SQL and excel formatting work as intended, but I ran into the issue of Access closing Outlook before the email leaves my outbox. Attempts to make Access wait or sleep until emails have been sent are causing the program to indefinetly hang. I would greatly appreciate any help you can provide on how to resolve this issue.
Thank you and please see below. My best guess at this point is that the sleep or wait methods I have used get stuck when two seperate Access Databases attempt to use them at the same time. I suspect this because when I run each process independently to debug, they are able to run without issues.
Windows Task Scheduler:
6:30AM (Task 1)(Run Time 2mins)- Access opens an internet page, pulls data, formats in excel, and saves to a network drive where a different program (not written by me) scoops up the data at 7:00 and uploads to SQL server. This is the first scheduled task and rarely has issues.
7:30AM (Task 2)(Run Time 5 mins) - Access connects to SQL, runs queries, exports results to excel file (no email).
7:35AM (Task 3)(Run Time 1.5hours) - Access connects to SQL, runs lots of very big queries, then exports file to excel and attempts to send emails. This one has issues where file is created and when I attempt to email, it either sits in outbox until I open outlook or file is created and it has trouble sending the email.
8:00AM (Task 4)(Run Time 3 mins) - Access connects to SQL, runs queries, sends emails. Usually has no issues but occasionally emails get stuck in Outbox.
8:00AM (Task 5)(Run Time 30 mins) - Access connects to SQL, runs queries, gets files from task 2, sends emails.
For all tasks, these are the settings:
Run only when user is signed on.
Run with highest privileges.
Action - Start a program (.bat)
The .bat files have this general format:
#echo on
cscript SCRIPT_NAME.vbs
The .vbs files have this general format:
Dim oAccessApp
Set oAccessApp = createObject("Access.Application")
oAccessApp.OpenCurrentDataBase("C:\PATHNAME.accdb")
oAccessApp.Visible = True
oAccessApp.Run "VBA_FUNCTION_NAME", "PARAMETERS"
oAccessApp.Application.Quit
Set oAccessApp = nothing
Outlook VBA Module
I suspect the issue I am having is related to the way I am sending the emails because the files output correctly even if the emails are not sent. Also, the code is able to run correctly when I test each .bat independently. Below please find my code that I use to send the emails.
Option Compare Database
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function sendToOutlook(sWhNo As String)
Dim s As String
Dim n As Integer
n = FreeFile()
Open "C:\PATHNAME\logfile.txt" For Output As #n
s = "Hello, world!"
Print #n, s
Dim XL As Excel.Application
Dim XlBook As Excel.Workbook
Dim fileNameLocation As String
Dim olApp As Outlook.Application
Dim olInsp As Outlook.Inspector
Dim olMail As Outlook.MailItem
Dim olAttachments As Outlook.Attachments
Dim subjectStr As String
Dim sWhString As String
Select Case sWhNo
Case "CASE_STATEMENTS_HERE"
subjectStr = "CITY_NAME"
sWhString = subjectStr
'more cases
End Select
Print #n, subjectStr
Print #n, sWhString
toStr = "email1#example.com;email2#example.com, etc"
bccStr = ""
subjectStr = subjectStr & "_" & exportTime & " REPORT_NAME"
fileLocation = "C:\TASK2_FILEPATH"
XlFileFormatStr = ".xlsx"
Print #n, toStr
Print #n, ccStr
Print #n, subjectStr
Print #n, fileLocation
Print #n, XlFileFormatStr
Dim qryRange1 As Excel.Range
Dim sFileLocation As String
Dim sFileName As String
Dim sFullFileNameLoc As String
Dim sMonthNum As String
Dim sDayNum As String
sFileLocation = "C:\CURRENT_TASK_PATHNAME\"
sDayNum = Day(Date)
If sDayNum - 10 < 0 Then sDayNum = "0" & Day(Date)
sMonthNum = Month(Date)
If sMonthNum - 10 < 0 Then sMonthNum = "0" & Month(Date)
sFileName = sWhNo & "_REPORT_NAME_" & Year(Date) & sMonthNum & sDayNum & ".xlsx"
Print #n, sFileName
sFullFileNameLoc = sFileLocation & sFileName
Print #n, sFullFineNAmeLoc
Set XL = CreateObject("Excel.Application")
Set XlBook = XL.Workbooks.Open(sFullFileNameLoc)
XL.DisplayAlerts = False
XL.AskToUpdateLinks = False
XL.EnableEvents = False
XL.Visible = True
Set qryRange1 = XlBook.Sheets("SHEET_NAME").Range(XlBook.Sheets("SHEET_NAME").Cells(1, 1).Address(), XlBook.Sheets("SHEET_NAME").Cells(11, 14).Address())
On Error Resume Next
Set olApp = New Outlook.Application
If Err.Number = 429 Then
Print #n, "429!!!"
Debug.Print "429!!!"
Set olApp = GetObject(, "Outlook.Application")
Set olInsp = olApp.ActiveInspector
Set olMail = olApp.CreateItem(olMailItem)
Set olAttachments = olMail.Attachments
GoTo LBL_CLOSE
End If
Set olInsp = olApp.ActiveInspector
Set olMail = olApp.CreateItem(olMailItem)
Set olAttachments = olMail.Attachments
olMail.SentOnBehalfOfName = "group_mailbox#example.com"
Print #n, "NO 429"
olAttachments.Add ("C:\TASK2_FILEPATH\" & exportFileNameGlobal_FINAL)
LBL_CLOSE:
Set qryRange1 = XlBook.Sheets("SHEET_NAME").Range(XlBook.Sheets("SHEET_NAME").Cells(1, 1).Address(), XlBook.Sheets("SHEET_NAME").Cells(11, 14).Address())
With olMail
.To = toStr
.CC = ccStr
.BCC = bccStr
.Subject = subjectStr
.HTMLBody = "Please find attached blah blah blah " & sWhString & vbCrLf & RangetoHTML(qryRange1, XL)
.Display
End With
Dim olAppNS As Outlook.Namespace
Dim olFolder As Outlook.Folder
With olMail
.Send
End With
XlBook.Close
XL.Quit
Set XlBook = Nothing
Set XL = Nothing
olApp.Quit
Set olApp = Nothing
Set olInsp = Nothing
Set olMail = Nothing
Set olAttachments = Nothing
Dim olApp1 As Outlook.Application
Set olApp1 = New Outlook.Application
Dim mySyncObject As Outlook.SyncObject
Dim sync As Outlook.SyncObject
Set olAppNS = olApp1.GetNamespace("MAPI")
Set olFolder1 = olAppNS.GetDefaultFolder(olFolderOutbox)
Set mySyncObjects = olAppNS.SyncObjects
For i = 1 To mySyncObjects.Count
Set sync = mySyncObjects(i)
sync.Start
Next
Do While olFolder1.Items.Count > 0
Sleep 10000
Loop
Close #n
Sleep 60000
olApp1.Quit
Set olApp1 = Nothing
Please advise what I am doing wrong that is causing access to hang and how I should fix. I greatly appreciate any help that you can provide. Thank you.

Answer 1

If you are using Exchange, you can turn cached mode off - message will be sent immediately. Otherwise you have no choice but to start the sync (SyncObject.Start) and wait for the SyncObject.SyncEnd event to fire.

Answer 2

Because of the nature of Office Applications, I'd guess that you're sleeping its only thread and it literally cannot attempt to send the mail while you're either eating up or throwing away all its CPU time. Instead of polling the mailbox and trying to manually wait for the mailitems to send, try using that SyncObject you've already made to register an event handler.
Here's an idea of what I mean. The following is a new class module:
Dim WithEvents mySync As Outlook.SyncObject
Dim myApp As Outlook.Application
Sub Close_After(ByRef toClose As Outlook.Application, ByRef newSync As Outlook.SyncObject)
Set myApp = toClose
Set mySync = newSync
mySync.Start
End Sub
Private Sub mySync_SyncEnd()
myApp.Quit
End Sub
This wraps around a SyncObject and gives it an event handler that will close the current application.
And in your calling code, do something like:
Dim syncClose As New SyncHandler ' Scope to module so we don't lose the reference
Function sendToOutlook(sWhNo As String)
' ...
Dim olApp1 As Outlook.Application
Set olApp1 = New Outlook.Application
' ...
Set olAppNS = olApp1.GetNamespace("MAPI")
Set olFolder1 = olAppNS.GetDefaultFolder(olFolderOutbox)
Set mySyncObjects = olAppNS.SyncObjects
syncClose.Close_After olApp1, (mySyncObjects(1))
End Function
This passes the first SyncObject into your class, which starts the sync and, when the sync completes, closes the passed-in Outlook.Application. If (for some reason) you have more than one SyncObject you want to wait for you'll have to restructure to ensure all have already finished before closing the app. The concept will be the same, though - build wrappers that register event handlers (or one big wrapper class that handles the events of many individual SyncObjects), but add a check that all the syncs must complete before the Application closes.

Answer 3

Although you indicate you want to use outlook, I found it was easier to not rely on Outlook for sending email, so I've used CDO for a very similar application. See email using Access and VBA without MAPI