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.