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:

Public Function CloseAllEmailMessages()

 

On Error GoTo ErrorHandler

 

   Dim appOutlook As Outlook.Application

   Dim ins As Outlook.Inspector

   Dim lngCount As Long

   Dim lngItem As Long

 

   Set appOutlook = GetObject(, "Outlook.Application")

 

   'Close all open email messages, working backwards

   'to prevent skipping any items

   lngCount = appOutlook.Inspectors.Count

   'Debug.Print "No. of inspectors: " & lngCount

 

   For lngItem = lngCount To 1 Step -1

      Set ins = appOutlook.Inspectors(lngItem)

      'Debug.Print "Item class: " & ins.CurrentItem.Class

 

      If ins.CurrentItem.Class = olMail Then

         Set msg = ins.CurrentItem

         'Debug.Print "Item To: " & msg.To

         msg.Close olDiscard

      End If

   Next lngItem

 

ErrorHandlerExit:

   Exit Function

 

ErrorHandler:

   MsgBox "Error No: " & Err.Number _

      & " in CloseAllEmailMessages procedure; " _

      & "Description: " & Err.Description

   Resume ErrorHandlerExit

 

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.