Microsoft Office Forums - View Single Post - [Solved] Emails sent from Access using Outlook are sent but left in outbox

gmayor · 08-20-2015, 10:18 PM

I found when developing http://www.gmayor.com/ManyToOne.htm that sending messages could be fraught with problems depending on the type and settings of the e-mail account so I produced a catch-all macro which will force the sending of any messages in the outbox. It basically opens each message in the Outbox and issues a send command then performs Send and Receive All.

Code:

Sub SendMessages()
Dim olApp As Object
Dim olItems As Object
Dim olItem As Object
Dim olNS As Object
Dim olSycs As Object
Dim olSyc As Object
Dim bStarted As Boolean
Dim i As Long

    On Error Resume Next

    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    Set olNS = olApp.GetNamespace("MAPI")
    olNS.logon
    Set olSycs = olNS.SyncObjects
    Set olItems = olNS.GetDefaultFolder(4).Items
    For i = olItems.Count To 1 Step -1
        Set olItem = olItems(i)
        olItem.sEnd
    Next i

    For i = 1 To olSycs.Count
        Set olSyc = olSycs.Item(i)
        olSyc.Start
    Next i
CleanUp:
    If bStarted = True Then
        olApp.Quit
    End If
    Set olApp = Nothing
    Set olItems = Nothing
    Set olItem = Nothing
    Set olNS = Nothing
    Set olSycs = Nothing
    Set olSyc = Nothing
lbl_Exit:
    Exit Sub
End Sub

The code as written is intended to be used from an Office application other than Outlook. It will need a few small changes (see below) if you want to run it from Outlook VBA

Code:

    'Set olApp = GetObject(, "Outlook.Application")
    Set olApp = Outlook.Application
    'If Err <> 0 Then
    '    Set olApp = CreateObject("Outlook.Application")
    '    bStarted = True
    'End If

    Set olNS = olApp.GetNamespace("MAPI")
    'olNS.logon