Delete draft mail on close when not sent

Question

I've got some draft mails with some buttons to copy and open them. Only a few values need to be filled in and then the mails will be sent. I want to keep the drafts. But if a mail is not sent, I would like to delete it because it is a copy. I'm working with the close event for a mail item, but I can't seem to find out how to delete it in that sub, tried many things. Anyone knows how to approach this?

Code I got so far in a module:

Dim itmevt As New CMailItemEvents
Public olMail As Variant
Public olApp As Outlook.Application
Public olNs As NameSpace
Public Fldr As MAPIFolder


Sub TeamcenterWEBAccount()

Dim i As Integer
Dim olMail As Outlook.MailItem

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderDrafts)

For Each olMail In Fldr.Items
    If InStr(olMail.Subject, "New account") <> 0 Then
        Set NewItem = olMail.Copy
        olMail.Display
        Set itmevt.itm = olMail
        Exit Sub
    End If
Next olMail

End Sub

Code in the CMailItemEvents class module:

Option Explicit
Public WithEvents itm As Outlook.MailItem

Private Sub itm_Close(Cancel As Boolean)
    Dim blnSent As Boolean
    On Error Resume Next
    blnSent = itm.Sent
    If blnSent = False Then
        itm.DeleteAfterSubmit = True
    Else
       ' do
End Sub

Answer 1

Please, try the next way:

1. Copy the next adapted code (instead of your code, or in a new standard module):

Option Explicit

Private itmevt As New CMailItemEvents
Public deleteFromDrafts As Boolean, boolContinue As Boolean

Sub TeamcenterWEBAccount()
 Dim olMail As Outlook.MailItem, NewItem As Outlook.MailItem, boolDisplay As Boolean
 Dim olApp As Outlook.Application, Fldr As MAPIFolder, olNs As NameSpace

 Set olApp = New Outlook.Application
 Set olNs = olApp.GetNamespace("MAPI")
 Set Fldr = olNs.GetDefaultFolder(olFolderDrafts)

 For Each olMail In Fldr.Items
    If InStr(olMail.Subject, "New account") > 0 Then
       On Error Resume Next  'for the case of inline response
       Set NewItem = olMail.Copy
       If Err.Number = -2147467259 Then
            Err.Clear: On Error GoTo 0
            olMail.Display: boolDisplay = True
            For i = 1 To 1000: DoEvents: Next i 'just wait for the window to be displayed...
            Set NewItem = olMail.Copy
       End If
       On Error GoTo 0
        deleteFromDrafts = False: boolContinue = False 'initialize the boolean variables to wait for them in the loop
        If Not boolDisplay Then olMail.Display
        Set itmevt.itm = olMail
        
        'wait for close event to be triggered...
        Do While deleteFromDrafts = False And boolContinue = False
                DoEvents
        Loop
        
        If deleteFromDrafts Then
                If Not olMail Is Nothing Then olMail.Delete 'let only the copy...
        End If
        Exit Sub
    End If
 Next olMail
End Sub

2. Copy the next adapted code to replace the existing one in the used class:

Option Explicit

Public WithEvents itm As Outlook.MailItem

Private Sub itm_Close(Cancel As Boolean)
    Dim blnSent As Boolean
    
    On Error GoTo Ending 'for the case of mail sending, when itm looses its reference...
        If blnSent = False Then
            itm.DeleteAfterSubmit = True
            deleteFromDrafts = True
        Else
           boolContinue = True
        End If
        Exit Sub
Ending:
    boolContinue = True
End Sub

Tested, but not intensively...

Please, send some feedback after testing it in your specific environment.

Answer 2

First of all, iterating over all items in the folder is not really a good idea:

For Each olMail In Fldr.Items
    If InStr(olMail.Subject, "New account") <> 0 Then

Instead, let the store provider do the job for you. The Find/FindNext or Restrict methods of the Items class allows getting items that correspond to your conditions, so you could iterate over items needed. Read more about these methods in the following articles:

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

You may try handling the Close event of the Inspector class which is fired when the inspector associated with a Microsoft Outlook item is being closed.

But I think none of them can be helpful. You need to re-design the whole solution by tracking for new items in the folder. And if new items have a custom property which indicates whether to remove the item or not you can do the additional actions. In the item-level event it is impossible to delete the source item.

Answer 3

My changes in module:

    Private itmevt As New CMailItemEvents
    Public deleteFromDrafts As Boolean, boolContinue As Boolean, boolDisplay As Boolean
    Private olMail As Outlook.MailItem, NewItem As Outlook.MailItem
    Private olApp As Outlook.Application, olNs As NameSpace, Fldr As MAPIFolder
    
    
    Sub TeamcenterWEBAccount()
        AccountOrInstallation ("Nieuw TC11 VDL ETG Teamcenter WEB account")
    End Sub
    
    Sub AccountOrInstallation(ByVal SearchStr As String)
    
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderDrafts)

    For Each olMail In Fldr.Items
        If InStr(olMail.Subject, SearchStr) > 0 Then
           On Error Resume Next  'for the case of inline response
           Set NewItem = olMail.Copy
           If Err.Number = -2147467259 Then
                Err.Clear: On Error GoTo 0
                olMail.Display: boolDisplay = True
                For i = 1 To 1000: DoEvents: Next i 'just wait for the window to be displayed...
                Set NewItem = olMail.Copy
           End If
           On Error GoTo 0
            deleteFromDrafts = False: boolContinue = False 'initialize the boolean variables to wait for them in the loop
            If Not boolDisplay Then olMail.Display
            Set itmevt.itm = olMail
            
            'wait for close event to be triggered...
            Do While deleteFromDrafts = False And boolContinue = False
                    DoEvents
            Loop
            
            If deleteFromDrafts Then
                    If Not olMail Is Nothing Then olMail.Delete 'let only the copy...
            End If
            Exit Sub
        End If
    Next olMail
    
End Sub