Code: close all open Outlook email messages without saving

Office for Mere Mortals helps people around the world get more from Word, Excel, PowerPoint and Outlook. Delivered once a week. free.

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



   Exit Function



   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. Independent since 1996. Delivered once a week.