Delete draft mail on close when not sent - vba

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:
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
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