Link to home
Start Free TrialLog in
Avatar of Fordraiders
FordraidersFlag for United States of America

asked on

Close Outlook after sending emails via vba without outbox getting stuck

outlook 2010  vba
Exchange server : company email system

I have vba code that sends emails.
does just fine.
Then i want to quit Outlook.
Application.Quit


Until in my code I want to close outlook after sending them.
I used this bit of code to rush and execute the send/receive, thinking it would force the outbox stuff to send.
but I keep getting the message "You have unsent emails..." counting down 30 seconds...
----------------------------------------------------------------------------------------------------------------------------------
Function Item_Open()
Dim strForm As String
Dim objFolder As Folder
Dim objItem As Outlook.MailItem
'Dim objRecip As Recipient
Dim strBcc As String
Dim objMail As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim mySyncObjects As Outlook.SyncObjects
Dim syc As Outlook.SyncObject
'strBcc = "xxx.xxxx@xxxx.com"

   
  strForm = "IPM.Note.proposalm"
  Set objFolder = _
    Application.ActiveExplorer.CurrentFolder
  Set objItem = _
    objFolder.Items.Add(strForm)
  objItem.To = "xxxx.xxxx@xxx.com"
     Set objRecip = objItem.Recipients.Add(strBcc)
    objRecip.Resolve
    If objRecip.Resolved Then
        objRecip.Type = olBCC    ' 3
    End If
  objItem.Subject = "Proposal Survey. Please Respond."
    objItem.Send
 ' objItem.Display
  Item_Open = True
     
' force the emails out of outbox ?
 Set mySyncObjects = Application.GetNamespace("MAPI").SyncObjects
 Set syc = mySyncObjects("All Accounts")
 syc.Start

Sleep (10000)

Application.Quit
End Function
Avatar of omgang
omgang
Flag of United States of America image

I wonder if you try checking to see when the Outbox is empty before quitting Outlook.

Dim objOutFolder As Folder
Set objOutFolder = Application.GetNamespace("MAPI").GetDefaultFolder("olFolderOutbox")

'set up your logic here - this is just an example
Do While objOutFolder.Items.Count > 0 Then
    'of course this has the opportunity to be an infinite loop if something else is wrong and the Outbox never gets emptied.  Consider this just an example
Loop
Application .Quit

OM Gang
Avatar of Fordraiders

ASKER

omgang,

got an error on this line ?
Set objOutFolder = Application.GetNamespace("MAPI").GetDefaultFolder("olFolderOutbox")
changed to ?
Set objOutFolder = Application.Session.GetDefaultFolder(olFolderOutbox).Items
??
yes, thrown into  a loop
So, to fix the error, get rid of the quotes around olFolderOutbox.

I did this to test
Public Function GetFolderItemCount() As Long

    Dim olNS As Outlook.NameSpace
    Dim olOutFolder As Outlook.Folder
    Dim lngItemCount As Long
    
    Set olNS = Outlook.GetNamespace("MAPI")
    Set olOutFolder = olNS.GetDefaultFolder(olFolderOutbox)
    
    lngItemCount = olOutFolder.Items.Count
    
Exit_GetFolderItemCount:
    Set olOutFolder = Nothing
    Set olNS = Nothing
    GetFolderItemCount = lngItemCount
    Exit Function
    
Err_GetFolderItemCount:
    MsgBox Err.Number & ", " & Err.Description, , "Error in GetFolderItemCount function"
    Resume Exit_GetFolderItemCount
    
End Function

Open in new window

So, why are the items staying in the Outbox?  I will see if I can replicate the issue on my end.  I'm currently using Outlook 2016 connected to Exchange.  I will post back with my results.
OM Gang
my guess is application.quit  is causing it
is there some way to revise your code to say...
hey i see 3 items...send them out ?
I'm a bit baffled.  Here's what I'm trying but no matter how long I wait the Outbox won't clear until after the code has finished running.  Once the code is done and I've clicked OK on the message box, the Outbox clears within a few seconds or so.

I like a challenge; haven't given up yet.   More tomorrow.
OM Gang


Public Function GetFolderItemCount() As Long

    Dim olNS As Outlook.NameSpace
    Dim olSyncObjects As Outlook.SyncObjects
    Dim olSync As Outlook.SyncObject
    Dim olOutFolder As Outlook.Folder, olCurFolder As Outlook.Folder
    Dim olMailItem As Outlook.MailItem
    Dim lngItemCount As Long, lngTimerCount As Long
    
    Set olNS = Outlook.GetNamespace("MAPI")
    Set olOutFolder = olNS.GetDefaultFolder(olFolderOutbox)
    Set olCurFolder = Outlook.ActiveExplorer.CurrentFolder
    
    Set olMailItem = olCurFolder.Items.Add
    olMailItem.To = "omgang@ee.com"
    olMailItem.Subject = "Test Message"
    olMailItem.HTMLBody = "<h3>This is the body</h3>"
    
    olMailItem.Send
    
    Set olSyncObjects = olNS.SyncObjects
    Set olSync = olSyncObjects(1)
    olSync.Start
    
    'Do While olOutFolder.Items.Count > 0
    '    DoEvents
    '    lngTimerCount = lngTimerCount + 1
    '    If lngTimerCount = 10000 Then Exit Do
    'Loop
        
    lngItemCount = olOutFolder.Items.Count
    
    'Application.Quit
    'Call CloseOutlookApp
    
    
    
Exit_GetFolderItemCount:
    Set olSync = Nothing
    Set olSyncObjects = Nothing
    Set olCurFolder = Nothing
    Set olMailItem = Nothing
    Set olOutFolder = Nothing
    Set olNS = Nothing
    GetFolderItemCount = lngItemCount
    Call ItemHasBeenSent
    Exit Function
    
Err_GetFolderItemCount:
    MsgBox Err.Number & ", " & Err.Description, , "Error in GetFolderItemCount function"
    Resume Exit_GetFolderItemCount
    
End Function




Public Sub ItemHasBeenSent()

    Dim lngStart As Long
    
    lngStart = Timer
    
    Do While Timer < lngStart + 45
        DoEvents
    Loop
    
    'Application.Quit
    MsgBox "Timer is done"


End Sub

Open in new window

I'm glad you like the challenge. Yes, the same issue basically.
I believe I have it figured out.
It seems that, even though the procedure code was destroying object variables Outlook wouldn't/couldn't close until the procedure had completed.  At least that's what my testing leads me to believe.  So I changed tactics a bit and decided to monitor the Outbox.  The trick, of course, is to only respond to the Outbox events under specific circumstances, i.e. you don't want Outlook closing every time a message leaves the Outbox.  Here's what I came up with ..... and it works even.....

You'll need to update your code in your Outlook and then exit Outlook and restart, so that the new Application_Startup event will fire and so the new public Boolean variable will be initialized to False.

ThisOutlookSession class module
Option Explicit

'module level object declaration
Dim WithEvents olkFolderItems As Outlook.Items


Private Sub Application_Quit()
On Error GoTo Err_Application_Quit
     'kill object reference when Outlook exits so it doesn't hang around in memory
    Set olkFolderItems = Nothing

Exit_Application_Quit:
    Exit Sub

Err_Application_Quit:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure Application_Quit of VBA Document ThisOutlookSession"
    Resume Exit_Application_Quit

End Sub


Private Sub Application_Startup()
On Error GoTo Err_Application_Startup

    'instantiate the module level object variable when Outlook first starts so we can monitor the folders items
    Set olkFolderItems = Session.GetDefaultFolder(olFolderOutbox).Items
    

Exit_Application_Startup:
    Exit Sub

Err_Application_Startup:
    MsgBox Err.Number & ", " & Err.Description, , "Error in Sub Application_Startup of VBA Document ThisOutlookSession"
    Resume Exit_Application_Startup
    
End Sub


Private Sub olkFolderItems_ItemRemove()

    'here's where we monitor the folder - every time an item is removed
    'but we only want to do something if the public variable is True
    If blExitApp = True Then
        'MsgBox "Item has been removed"
        Application.Quit
    End If

End Sub

Open in new window



Module1
Option Explicit

'public variable declaration
Public blExitApp As Boolean

Public Function GetFolderItemCount() As Long

    Dim olNS As Outlook.NameSpace
    Dim olSyncObjects As Outlook.SyncObjects
    Dim olSync As Outlook.SyncObject
    Dim olOutFolder As Outlook.Folder, olCurFolder As Outlook.Folder
    Dim olMailItem As Outlook.MailItem
    Dim lngItemCount As Long, lngTimerCount As Long
    
    Set olNS = Outlook.GetNamespace("MAPI")
    Set olOutFolder = olNS.GetDefaultFolder(olFolderOutbox)
    Set olCurFolder = Outlook.ActiveExplorer.CurrentFolder
    
    Set olMailItem = olCurFolder.Items.Add
    olMailItem.To = "omgang@ee.com"
    olMailItem.Subject = "Test Message"
    olMailItem.HTMLBody = "<h3>This is the body</h3>"
    
    olMailItem.Send
    
    Set olSyncObjects = olNS.SyncObjects
    Set olSync = olSyncObjects(1)
    olSync.Start
    
    'here's where we set the public variable to True so the folder monitoring sub routine knows to take action
    blExitApp = True
    
Exit_GetFolderItemCount:
    Set olSync = Nothing
    Set olSyncObjects = Nothing
    Set olCurFolder = Nothing
    Set olMailItem = Nothing
    Set olOutFolder = Nothing
    Set olNS = Nothing
    GetFolderItemCount = lngItemCount
    Exit Function
    
Err_GetFolderItemCount:
    MsgBox Err.Number & ", " & Err.Description, , "Error in GetFolderItemCount function"
    Resume Exit_GetFolderItemCount
    
End Function

Open in new window

wow...give me some time to soak it in....will work on it tonight...
Thanks for the extreme amount of work.

It has taken awhile to get someone to be this close to understanding what was going on..
very hard to explain , especially me to interpret to some to EE.
fordraiders
No rush.  I was fortunate to have the Outlook folder monitoring routine already written; it's why I thought of doing it this way.  I wrote it originally to monitor incoming messages into a secondary mailbox; every time a message would arrive in that mailbox (ItemAdd) I'd have it play a .wav file to alert me.

OM Gang
ok...how do we start off the emails..
Would we not have to call the:

GetFolderItemCount ?


In Application_Startup ?

Set olkFolderItems = Session.GetDefaultFolder(olFolderOutbox).Items
'adding the call and quitting ?
Call GetFolderItemCount
Application.Quit



dp
with what i just posted:
I got the msgbox,   You have unsent messages in your ourbox...etc...


this is never called ?
olkFolderItems_ItemRemove
You don't want to have an
Application.Quit command
It's included in the folder monitoring routine.

How do you intend to run Outlook utilizing this functionality?  Have Outlook auto-start, send one or more messages, and then exit?

Let me know.
OM Gang
yes...by calling this...

Call GetFolderItemCount

once those one or multiple emails are completed...quit outlook.
Do you have some sub routine or code that does nothing but loop and kill seconds..instead of the
sleep (2000)  call  ?  by chance ?

run it for 10 seconds...then get out of the loop lon enough for outllook to  exit the outbox ?
found this,
but still no matter what i do...outbox will not empty..


if i debug through the code...works perfect...step by step
??
I got it to do what you want with a simple add.  See below but SEE MY WARNING FIRST.
Outlook opens for a few seconds and then exits.

WARNING - this will cause Outlook to open, send the message and the exit.  It may be difficult to get access to the VBA code to turn it off.  I think you should consider adding a prompt asking whether or not to call the function.

OM Gang.

Private Sub Application_Startup()
On Error GoTo Err_Application_Startup

   dIm lngFolderItemCount As Long        <------   add this declaration

    'instantiate the module level object variable when Outlook first starts so we can monitor the folders items
    Set olkFolderItems = Session.GetDefaultFolder(olFolderOutbox).Items
   
   lngFolderItemCount = GetFolderItemCount()      <-----  add this function call

Exit_Application_Startup:
    Exit Sub

Err_Application_Startup:
    MsgBox Err.Number & ", " & Err.Description, , "Error in Sub Application_Startup of VBA Document ThisOutlookSession"
    Resume Exit_Application_Startup
   
End Sub
omgang, With the code you provided worked...Can you briefly explain how ? In A nutshell.
Basically releasing the variables and objects correctly ?

fordraiders
and how is this ever called ?
Private Sub olkFolderItems_ItemRemove()

    'here's where we monitor the folder - every time an item is removed
    'but we only want to do something if the public variable is True
    If blExitApp = True Then
        'MsgBox "Item has been removed"
        Application.Quit
    End If

End Sub


to know how to quit ?
The Application_Startup event/routine is doing two things
1) creates/instantiates and Outlook Items object on the Outbox folder
2) calls a public function :: GetFolderItemCount

The GetFolderItemCount does just a few simple things
1) draft and send an email message
2) perform a Send/Receive
3) set a value on a publicly declared variable

It's the olkFolderItemsRemove sub routine that's doing the magic here.  It fires everytime an item is removed from the specified folder (the one we instantiated in the Application_Startup event).  So each time an item is removed from the folder it first checks the value of the public variable (the conditional statement).  When that variable is True it executes the Application.Quit command.
This sub is an event handler; kind of like a button click event.

Make sense?
OM Gang
Yes, but...As long as ... Will it be an issue if
I send 3 emails out. In a loop sequence later. ?

Do while
' code
.send
Loop

Fordraiders
ASKER CERTIFIED SOLUTION
Avatar of omgang
omgang
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
If i could give a thousand points i would..
Good working with you.
OM Gang
I don't think you realize the accomplishment you made here. You solved a problem. No one else could. I cant tell you how many threads ask this. So many threads are YEARS old!!! Great job!
Thanks for your kind words.  I appreciate it.
OM Gang
omgang,
One small last issue.
If i loop through the recordset and find records...
Exits Great !!

If i loop through the recordset and find zero records..
I need to exit the function and still close outlook.

I thought this would do it ?  but not working.
tp = rs.RecordCount
If tp <> 0 Then
' looking to see if we find any records within 30 days
   rs.MoveLast
   rs.MoveFirst
Else '  it is a zero count get out of routine
   rs.Close
   db.Close
   Set rs = Nothing
   Set db = Nothing
  'MsgBox "no records"
  Set olSyncObjects = olNS.SyncObjects
       Set olSync = olSyncObjects(1)
       olSync.Start
       blExitApp = True
   Exit Function

Thanks
again
The problem here is that the olkFolderItems_ItemRemove procedure is monitoring the Outbox for when a Item is sent/removed.  If that doesn't happen then the Application.Quit command is never called.
I think the simplest solution here is to send a dummy message, doesn't even have to be to a valid address.  In my testing I was sending messages to omgang@ee.com which is a bogus address but it suffices as the message enters and then, more importantly, leaves the Outbox.
OM Gang
Thanks as always.
I just remembered , i had
Application. Quit

Which worked.