Code: close all open Outlook email messages without saving


Here is a procedure that will close all open Outlook email messages without saving – very handy if you have just created hundreds of emails testing email creation with the Emailing Order Lists to Customers database:

1
Public Function CloseAllEmailMessages()
1
 
1
On Error GoTo ErrorHandler
1
 
1
   Dim appOutlook As Outlook.Application
1
   Dim ins As Outlook.Inspector
1
   Dim lngCount As Long
1
   Dim lngItem As Long
1
 
1
   Set appOutlook = GetObject(, "Outlook.Application")
1
 
1
<strong><em>   'Close all open email messages, working backwards</em></strong>
1
<strong><em>   'to prevent skipping any items</em></strong>
1
   lngCount = appOutlook.Inspectors.Count
1
   'Debug.Print "No. of inspectors: " &amp; lngCount
1
 
1
   For lngItem = lngCount To 1 Step -1
1
      Set ins = appOutlook.Inspectors(lngItem)
1
      'Debug.Print "Item class: " &amp; ins.CurrentItem.Class
1
 
1
      If ins.CurrentItem.Class = olMail Then
1
         Set msg = ins.CurrentItem
1
         'Debug.Print "Item To: " &amp; msg.To
1
         msg.Close olDiscard
1
      End If
1
   Next lngItem
1
 
1
ErrorHandlerExit:
1
   Exit Function
1
 
1
ErrorHandler:
1
   MsgBox "Error No: " &amp; Err.Number _
1
      &amp; " in CloseAllEmailMessages procedure; " _
1
      &amp; "Description: " &amp; Err.Description
1
   Resume ErrorHandlerExit
1
 
1
End Function

 

You can run this procedure from a macro, using the RunCode macro action, as in the mcrCloseAllEmailMessages macro in the sample database.


Want More?

Office Watch has the latest news and tips about Microsoft Office.  Delivered once a week.