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
Please, try the next way:
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
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.