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