Removing Signatures / attachments from outlook emails going to Mac users or SpiceWorks

Question

So here's an interesting problem I stumbled upon on. I’m running into issues by sending emails out to SpiceWorks and Mac users.

When a user has a problem they will email Help Desk. We setup a personal Outlook email to handle Help Desk tickets. Once the ticket hits the outlook mailbox it will automatically be sent to our SpiceWorks site.

Now all of our emails have signatures and there are certain signatures with small png image logos (Youtube, LinkedIn, Facebook, and Twitter). When the email hits SpiceWorks it uploads those png images as attachments. These attachments cause most of the problems because some email threads get very long before they even get submitted as an help desk ticket. They would end up with maybe 20+ attachments of the same four logo png's.

I coded to remove all attachments to that specific address but some users send actual attachments. I tried remove the specific attachments by name but if there are duplicates of same .png image they would just iterate. (img001 through img004 is now img005 through img009)

I found the current VBA script in the HelpDesk Outlook. I was told that Outlook has to be running all the time in order for it to work... sometimes.

I started writing my own script where it checks if the current email is going to HelpDesk email address then remove the attachemnts. No luck yet.

Current Code

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim msg As Outlook.MailItem
Dim recips As Outlook.Recipients
Dim str As String
Dim emailAddress As String
Dim prompt As String

Dim msgbody As String
msgbody = Item.Body   

  Set msg = Item 'Subject Message
  Set recips = msg.Recipients

  str = "HelpDesk"


  For x = 1 To GetRecipientsCount(recips)
    str1 = recips(x)
    If str1 = str Then
      'MsgBox str1, vbOKOnly, str1 'For Testing

      prompt = "Are you sure you want to send to " & str1 & "?" 'For Testing

      If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then 'For Testing
        Cancel = True
      End If

      'if attachments are there
    If Item.Attachments.Count > 0 Then

        'for all attachments
        For i = Item.Attachments.Count To 1 Step -1  

            'if the attachment's filename is similar to "image###.png", remove
            If InStr(Item.Attachments(i).FileName, "image") > 0 And Right(Item.Attachments(i).FileName, 4) = ".png" Then
                MsgBox ("Item Removed " + Item.Attachments(i))
                Item.Attachments.Remove (i)
            End If

        Next
    End If   

    End If
  Next x
End Sub

Public Function GetRecipientsCount(Itm As Variant) As Long
' pass in a qualifying item, or a Recipients Collection
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem, AppointmentItem, JournalItem, MeetingItem, TaskItem", ",")

  Select Case True
    ' these items have a Recipients collection
    Case UBound(Filter(types, TypeName(Itm))) > -1
      Set obj = Itm
      Set recips = obj.Recipients
    Case TypeName(Itm) = "Recipients"
      Set recips = Itm
  End Select

  GetRecipientsCount = recips.Count
End Function

A few questions:

1.) Is there a way to set rules in outlook(Looked at numerous possibilities) or do something with the Exchange Server to stop this from happening?

2.) With Vba is there a way to remove or not allow a signature when the email is sent?

If anything, my ultimate goal is just to prevent those .png's being uploaded as images to Mac users and SpiceWorks.

I'm sure there is more to this but I will gladly answer any questions given to me.

Thank you for any help or directions!

Answer 1

If I understand you correctly, you're trying to remove .png files being sent to SpiceWorks. If so, use the macro below from the Outlook mailbox sending to SpiceWorks. On the ItemSend event, this will check the filename of all attachments and remove those with .png extensions. If this is not what you're trying to do, post back here. Thanks.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    'if attachments are there
    If Item.Attachments.count > 0 Then

        'for all attachments
        For i = Item.Attachments.count To 1 Step -1

            'if the attachment's extension is .png, remove
            If Right(Item.Attachments(i).FileName, 4) = ".png" Then
                Item.Attachments.Remove (i)
            End If
        Next
    End If
End Sub

----- updated to only remove attachments that look like "image###.png" -----

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    'if attachments are there
    If Item.Attachments.count > 0 Then

        'for all attachments
        For i = Item.Attachments.count To 1 Step -1

            'if the attachment's filename is similar to "image###.png", remove
            If InStr(Item.Attachments(i).FileName, "image") > 0 And Right(Item.Attachments(i).FileName, 4) = ".png" Then
                Item.Attachments.Remove (i)
            End If

        Next
    End If
End Sub

----- updated to only remove attachments that are <10kb and look like "image###.png"-----

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    'if attachments are there
    If Item.Attachments.count > 0 Then

        'for all attachments
        For i = Item.Attachments.count To 1 Step -1

            'if attachment size is less than 10kb
            If Item.Attachments(i).Size < 10000 Then
                'if the attachment's filename is similar to "image###.png", remove
                If InStr(Item.Attachments(i).FileName, "image") > 0 And Right(Item.Attachments(i).FileName, 4) = ".png" Then
                    Item.Attachments.Remove (i)
                End If
            End If
        Next
    End If
End Sub