Delete Just Sent Mail from Sent Items Folder

[gmaxey]

Hi,

I'm attempting to use the following code to send an email using OUTLOOK from Word. The code runs without error, but the e-mail is apparently not sent (not received on other end).

If if remove this line:
oMailItem.DeleteAfterSubmit = True

The mail is sent (received) but remains in the sent items folder.

How can I send an email and then immediately remove it from the sent items folder.

Thanks


Option Explicit
Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6

Sub SendBillingLogToSam(bWAttachment As Boolean, Optional strAttachmentPath As String)
Dim oOutlookApp As Object, oNS As Object, oInsp As Object
Dim oFolder As Object, oMailItem As Object
Dim lngState As Long

lngState = Application.WindowState
Application.WindowState = wdWindowStateMinimize
Application.ScreenUpdating = False
Set oOutlookApp = OutlookApp()
Set oNS = oOutlookApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
'Create a new message
Set oMailItem = oOutlookApp.CreateItem(0) 'olMailItem
With oMailItem
.To = "sam@jonesfirm.com"
.Subject = "TEST TEST TEST Past Billing Log with Auto Delete from Sent Items Folder TEST TEST TEST"
If bWAttachment Then
.Attachments.Add strAttachmentPath
.Body = "Sam, " & vbCr + vbCr & "Here is the latest billing log on file."
Else
.Body = "Sam," & vbCr + vbCr & "There was no past billing log found on file."
End If
oMailItem.Sent
End With
oMailItem.DeleteAfterSubmit = True
Application.WindowState = lngState
Application.ScreenUpdating = True
lbl_Exit:
Set oOutlookApp = Nothing: Set oNS = Nothing
Set oFolder = Nothing
Set oMailItem = Nothing
End Sub


Public Function OutlookApp(Optional WindowState As Long = olMinimized, _
Optional ReleaseIt As Boolean = False) As Object
Static oApp As Object
On Error GoTo ErrHandler
Select Case True
Case oApp Is Nothing, Len(oApp.Name) = 0
Set oApp = GetObject(, "Outlook.Application")
If oApp.Explorers.Count = 0 Then
InitOutlook:
'Open inbox to prevent errors with security prompts
oApp.Session.GetDefaultFolder(olFolderInbox).Display
oApp.ActiveExplorer.WindowState = WindowState
End If
Case ReleaseIt: Set oApp = Nothing
End Select
Set OutlookApp = oApp
ExitProc:
Exit Function
ErrHandler:
Select Case Err.Number
Case -2147352567
'User cancelled setup, silently exit
Set oApp = Nothing
Case 429, 462
Set oApp = GetOutlookApp()
If oApp Is Nothing Then
Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
Else
Resume InitOutlook
End If
Case Else: MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
End Select
Resume ExitProc
Resume
End Function


Private Function GetOutlookApp() As Object
On Error GoTo ErrHandler
Set GetOutlookApp = CreateObject("Outlook.Application")
ExitProc:
Exit Function
ErrHandler:
Set GetOutlookApp = Nothing
Resume ExitProc
Resume
End Function

[Logit]

.
"Immediately delete from the Sent Folder" ... is what your code is presently doing. However, it would appear the code at present
is somehow deleting the email before it gets sent ... even though it shouldn't. This observation is based on your comments of
what is presently occurring.

You could attempt to include a delay in your code, just prior to deleting the email from the Sent Folder. Perhaps give it 5 seconds ?
Hopefully that will give your system and Outlook to send the email first.

Just a thought.

[gmayor]

The following works as intended here (I have Outlook configured not to send immediately). The message is delivered to the outbox and removed from the sent items folder (when you send it). I have sent you the example message from the code, so if you get it, it will confirm that it works.

Note that the line should be oMailItem.Send not oMailItem.Sent and you should set the deleteaftersubmit option before you send it.

As you have set a variable to oInsp you should use it to format your message as that will also keep your signature. oFolder is superfluous



Sub Test()
SendBillingLogToSam False
End Sub




Sub SendBillingLogToSam(bWAttachment As Boolean, Optional strAttachmentPath As String)
Dim oOutlookApp As Object, oNS As Object, oInsp As Object
Dim oFolder As Object, oMailItem As Object
Dim lngState As Long
Dim wdDoc As Document
Dim oRng As Range


lngState = Application.WindowState
Application.WindowState = wdWindowStateMinimize
Application.ScreenUpdating = False
Set oOutlookApp = OutlookApp()
Set oNS = oOutlookApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
'Create a new message
Set oMailItem = oOutlookApp.CreateItem(0) 'MailItem
With oMailItem
Set oInsp = .GetInspector
Set wdDoc = oInsp.WordEditor
Set oRng = wdDoc.Range
oRng.Collapse 1
.Display 'required
.DeleteAfterSubmit = True
.To = "sam@jonesfirm.com"
.Subject = "TEST TEST TEST Past Billing Log with Auto Delete from Sent Items Folder TEST TEST TEST"
If bWAttachment Then
.Attachments.Add strAttachmentPath
oRng.Text = "Sam, " & vbCr + vbCr & "Here is the latest billing log on file."
Else
oRng.Text = "Sam," & vbCr + vbCr & "There was no past billing log found on file."
End If
oMailItem.Send
End With
Application.WindowState = lngState
Application.ScreenUpdating = True
lbl_Exit:
Set oOutlookApp = Nothing: Set oNS = Nothing
Set oFolder = Nothing
Set oMailItem = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub