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



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