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