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

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.

How about only opening a new Outlook application if you can't already find one. Then leave it open and don't try close from your app. — Andrew Mortimer, Aug 29 '16 at 16:33
Andrew, I am doing the inverse of your suggestion. I attempt to create a new outlook object and if one exists (Error 429), I get that object. — r4diant373, Aug 29 '16 at 18:23

score 1 · Answer 1 · answered Aug 29 '16 at 16:42

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.

answered Aug 29 '16 at 16:42

Dmitry Streblechenko

62,942
4
53
78

Thanks for the reply. Question: The attachments on the emails that I send are large (~5MB), wondering if doing this would still have the message stuck in the outbox before the email is fully sent? – r4diant373 Aug 29 '16 at 18:12
Also does this change affect the whole account or just one computer? I have a laptop and mobile that I would like to keep on cached mode. – r4diant373 Aug 29 '16 at 18:33
The setting is per profile on the particular machine. – Dmitry Streblechenko Aug 29 '16 at 20:17
If the attachment is too big, you will receive ab NDR in your Inbox. – Dmitry Streblechenko Aug 29 '16 at 20:17
Not worried about the attachment being too big, just want to make sure that outlook won't close before the email is fully sent. – r4diant373 Aug 29 '16 at 20:31
In the online mode message submission is an atomic operation- the message is simply marked as ready for submission, and the online store pick it up from there. Outlook does not need to stay open. – Dmitry Streblechenko Aug 29 '16 at 20:32
Ok thank you Dmitry, have set up one of my Access DB's to use this tomorrow, will see how it goes. – r4diant373 Aug 29 '16 at 22:27
Dmitry, your solution worked and also was the easiest to implement. Well done! – r4diant373 Sep 02 '16 at 17:33

Mikegrann · Answer 2 · 2016-08-29T19:20:53.627

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.

Thanks for the quick and thorough reply! I will try this now and let you know how it goes. Question: SyncObject is Outlook specific right? It will not close access when I call that method correct? — r4diant373, Aug 29 '16 at 18:22
@r4diant373 Great point! I had actually tested this inside Outlook itself, so I didn't catch that `Application.Quit` would close the host application (Access), not the `Outlook.Application`. I've modified the code a bit to also store a reference to the current app so it knows what to close when the event is triggered. — Mikegrann, Aug 29 '16 at 19:24

score 0 · Answer 3 · edited May 23 '17 at 12:08

0

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

edited May 23 '17 at 12:08

Community

1
1

answered Aug 29 '16 at 17:40

Knox

2,909
11
37
65

Thank you for posting this. Question: would I be able to use CDO to send on behalf of a group mailbox? Not sure how I would authenticate against that as this is not a regular enterprise user account. – r4diant373 Aug 29 '16 at 18:10
I'm sorry, i don't know. I used it to send using GMail, but believe that any SMPT mailserver would work. You might be able to do that, but have the "Reply To" field set to your group mailbox. – Knox Aug 29 '16 at 19:28

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

Windows Task Scheduler:

Outlook VBA Module

3 Answers3