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.
