Cant delete emails

[niall91]

Hi

At the end of the sub Im trying to delete or move the email to the trash but it doesn't do anything.
Doesn't have an error message either.
Any ideas?

Sub SaveMessageAsMsg(ByVal oPath As String)
  Dim oMail As Outlook.MailItem
  Dim objItem As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String
  Dim enviro As String
 
For Each objItem In ActiveExplorer.Selection
    If objItem.MessageClass = "IPM.Note" Then
        Set oMail = objItem
        
        sName = InputBox("This email will be saved to:" & vbNewLine & oPath & vbNewLine & "Please enter an Email name?", "Save Email")
        
        If IsEmpty(sName) Or sName = "" Then
            sName = "Email Order"
        Else
            sName = "Email Order - " & sName 'oMail.Subject
        End If
        ReplaceCharsForFileName sName, "-"

        dtDate = oMail.ReceivedTime
        sName = sName & " - " & Format(dtDate, "dd", vbUseSystemDayOfWeek, _
          vbUseSystem) & ".msg"

        
        oMail.SaveAs oPath & sName, olMSG

        aws = MsgBox("Would you like to move Email to the trash", vbYesNo)
        If aws = vbYes Then
            On Error Resume Next
            oMail.Delete
        End If
    
    End If
Next
  
End Sub