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