Fordraiders
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 .CurrentFo lder
Set objItem = _
objFolder.Items.Add(strFor m)
objItem.To = "xxxx.xxxx@xxx.com"
Set objRecip = objItem.Recipients.Add(str Bcc)
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").Syn cObjects
Set syc = mySyncObjects("All Accounts")
syc.Start
Sleep (10000)
Application.Quit
End Function
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
Set objItem = _
objFolder.Items.Add(strFor
objItem.To = "xxxx.xxxx@xxx.com"
Set objRecip = objItem.Recipients.Add(str
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("
Set syc = mySyncObjects("All Accounts")
syc.Start
Sleep (10000)
Application.Quit
End Function
ASKER
omgang,
got an error on this line ?
Set objOutFolder = Application.GetNamespace(" MAPI").Get DefaultFol der("olFol derOutbox" )
changed to ?
Set objOutFolder = Application.Session.GetDef aultFolder (olFolderO utbox).Ite ms
??
got an error on this line ?
Set objOutFolder = Application.GetNamespace("
changed to ?
Set objOutFolder = Application.Session.GetDef
??
ASKER
yes, thrown into a loop
So, to fix the error, get rid of the quotes around olFolderOutbox.
I did this to test
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
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
OM Gang
ASKER
my guess is application.quit is causing it
ASKER
is there some way to revise your code to say...
hey i see 3 items...send them out ?
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
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
ASKER
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
Module1
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
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
ASKER
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
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
OM Gang
ASKER
ok...how do we start off the emails..
Would we not have to call the:
GetFolderItemCount ?
In Application_Startup ?
Set olkFolderItems = Session.GetDefaultFolder(o lFolderOut box).Items
'adding the call and quitting ?
Call GetFolderItemCount
Application.Quit
dp
Would we not have to call the:
GetFolderItemCount ?
In Application_Startup ?
Set olkFolderItems = Session.GetDefaultFolder(o
'adding the call and quitting ?
Call GetFolderItemCount
Application.Quit
dp
ASKER
with what i just posted:
I got the msgbox, You have unsent messages in your ourbox...etc...
this is never called ?
olkFolderItems_ItemRemove
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
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
ASKER
yes...by calling this...
Call GetFolderItemCount
once those one or multiple emails are completed...quit outlook.
Call GetFolderItemCount
once those one or multiple emails are completed...quit outlook.
ASKER
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 ?
sleep (2000) call ? by chance ?
run it for 10 seconds...then get out of the loop lon enough for outllook to exit the outbox ?
ASKER
found this,
but still no matter what i do...outbox will not empty..
if i debug through the code...works perfect...step by step
??
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(o lFolderOut box).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
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(o
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
ASKER
omgang, With the code you provided worked...Can you briefly explain how ? In A nutshell.
Basically releasing the variables and objects correctly ?
fordraiders
Basically releasing the variables and objects correctly ?
fordraiders
ASKER
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 ?
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
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
ASKER
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
I send 3 emails out. In a loop sequence later. ?
Do while
' code
.send
Loop
Fordraiders
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
If i could give a thousand points i would..
Good working with you.
OM Gang
OM Gang
ASKER
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
OM Gang
ASKER
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
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
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
ASKER
Thanks as always.
I just remembered , i had
Application. Quit
Which worked.
I just remembered , i had
Application. Quit
Which worked.
Dim objOutFolder As Folder
Set objOutFolder = Application.GetNamespace("
'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