Create a rule that deletes attachments before forwarding

Question

I have been tasked to create an automated report system where an report from Google Data Studios are uploaded to specific projects (On a site called Basecamp). The reports always include both a report within the body of the e-mail and an attached PDF file. The are sent to a Gmail account (data studios refuse to schedule towards a non-Google account). The filters within Gmail doesnt really work well with the Basecamp system so I use filters to re-route them towards a Outlook account. There I use rules to send each e-mail towards the correct client within Basecamp.

Here comes the problem, Basecamp shows both the body of the e-mail AND the attached PDF version which makes us show duplicates.

Is there a way to create a macro that first deletes all attachments (or body of an e-mail) and THEN forward the e-mail.

It cant be done manually it have to be a rule that does it automaticaly. Keep in mind that I am not a coder and have never done anything like this so please keep it simple for my dumb brain!

Thank you in advance! Marcus

PS: I found a code that seems to be what I am after.

Public WithEvents ReceivedItems As Outlook.Items

Private Sub Application_Startup()
    Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
    Dim xForwardMail As Outlook.MailItem
    Dim xEmail As MailItem
    On Error Resume Next
    If Item.Class <> olMail Then Exit Sub
    Set xEmail = Item
    If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub  'change subject text to your need
    If xEmail.Attachments.Count = 0 Then Exit Sub
    Set xForwardMail = xEmail.Forward
    With xForwardMail
        .HTMLBody = ""
        With .Recipients
            .Add "[email protected]"    'change address to your own
            .ResolveAll
        End With
        .Send
    End With
End Sub

I am trying to get that code to work, and changes the subject to a specific word and then route it to a final e-mail account that then filters out to correct clients. However the code doesnt seem to work, it DOES forward the e-mail but the attachment is still there. The code was found at https://www.extendoffice.com/documents/outlook/5359-outlook-forward-attachment-only.html#a1

Answer 1

It seems you need to modify the code slightly:

Public WithEvents ReceivedItems As Outlook.Items

Private Sub Application_Startup()
    Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
    Dim xForwardMail As Outlook.MailItem
    Dim xEmail As MailItem
    Dim myattachments as Outlook.Attachments

    On Error Resume Next
    If Item.Class <> olMail Then Exit Sub
    Set xEmail = Item
    If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub  'change subject text to your need
    If xEmail.Attachments.Count = 0 Then Exit Sub
    Set xForwardMail = xEmail.Forward
    
    Set myattachments = xForwardMail.Attachments 
 
    While myattachments.Count > 0 
      myattachments.Remove 1 
    Wend 

    With xForwardMail
        .HTMLBody = ""
 
        With .Recipients
            .Add "[email protected]"    'change address to your own
            .ResolveAll
        End With
        .Send
    End With
End Sub

The Remove method of the Attachments class removes an object from the collection.