删除发给Mac用户或SpiceWorks的outlook电子邮件中的签名/附件

Question

所以我偶然发现了一个有趣的问题。通过向SpiceWorks和Mac用户发送电子邮件，我遇到了麻烦。

当用户遇到问题时，他们会给服务台发电子邮件。我们设置了一个个人Outlook电子邮件来处理服务台的票证。一旦票证到达outlook邮箱，它将自动发送到我们的SpiceWorks站点。

现在，我们所有的电子邮件都有签名，并且有一些带有小型png图像标识的签名(Youtube、LinkedIn、Facebook和Twitter)。当电子邮件到达SpiceWorks时，它会将这些png图像作为附件上传。这些附件导致了大多数问题，因为有些电子邮件线程甚至在作为帮助台票证提交之前就已经很久了。他们最终可能会与20+附件相同的四个标志巴布亚新几内亚的。

我编码以删除该特定地址的所有附件，但有些用户发送实际的附件。我试着按名称删除特定的附件，但是如果有相同的.png映像的副本，它们只会迭代。(img001通过img004，现在img005通过img009)

我在HelpDesk Outlook中找到了当前的VBA脚本。我被告知Outlook必须一直运行才能正常工作.有时候。

我开始写我自己的脚本，它检查当前的电子邮件是否要发送到HelpDesk电子邮件地址，然后删除附件。还没有运气。

电流码

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

几个问题：

1.)是否有办法在outlook中设置规则(查看了许多可能性)，或者使用Exchange来阻止这种情况发生？

2.)对于Vba，在发送电子邮件时是否有删除或不允许签名的方法？

如果有的话，我的最终目标就是防止这些..png作为图片上传到Mac用户和SpiceWorks。

我相信还有更多的，但我会乐意回答任何问题给我。

谢谢您的帮助或指导！

Answer 1

如果我对您的理解是正确的，您将尝试删除发送到SpiceWorks的SpiceWorks文件。如果是，请在发送到SpiceWorks的Outlook邮箱中使用下面的宏。在ItemSend事件上，这将检查所有附件的文件名，并删除那些带有.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 extension is .png, remove
            If Right(Item.Attachments(i).FileName, 4) = ".png" Then
                Item.Attachments.Remove (i)
            End If
        Next
    End If
End Sub

--更新为只删除看起来像"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

--更新为只删除<10 to且看起来像“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