Mac 사용자 또는 SpiceWorks로가는 Outlook 전자 메일에서 서명/첨부 파일 제거

Question

그래서 내가 발견 한 흥미로운 문제가 있습니다. SpiceWorks 및 Mac 사용자에게 이메일을 보내 문제를 겪고 있습니다.

사용자에게 문제가 발생하면 헬프 데스크로 이메일을 보내 게됩니다. 헬프 데스크 티켓을 처리하기 위해 개인 Outlook 이메일을 설정했습니다. 티켓이 Outlook 사서함에 도착하면 자동으로 SpiceWorks 사이트로 전송됩니다.

이제 모든 이메일에는 서명이 있으며 작은 png 이미지 로고 (Youtube, LinkedIn, Facebook 및 Twitter)가있는 특정 서명이 있습니다. 이메일이 SpiceWorks에 도달하면 해당 PNG 이미지를 첨부 파일로 업로드합니다. 일부 전자 메일 스레드는 헬프 데스크 티켓으로 제출되기 전에 매우 오래 걸리기 때문에 이러한 첨부 파일로 인해 대부분의 문제가 발생합니다. 그들은 아마 같은 4 개의 로고 png의 20 개 이상의 첨부 파일로 끝날 것입니다.

특정 주소에 대한 모든 첨부 파일을 제거하도록 코딩되었지만 일부 사용자는 실제 첨부 파일을 보냅니다. 특정 첨부 파일을 이름으로 제거하려고 시도했지만 동일한 .png 이미지가 중복되면 반복됩니다. (img001부터 img004까지는 img009부터 img009까지입니다)

HelpDesk Outlook에서 현재 VBA 스크립트를 발견했습니다. Outlook이 항상 작동하도록하기 위해서는 항상 Outlook을 실행해야한다고 들었습니다.

현재 전자 메일이 HelpDesk 전자 메일 주소로 전송되는지 확인한 다음 스크립트에서 attachemnts를 제거하는 스크립트를 작성하기 시작했습니다. 행운은 아직 없습니다.

현재 코드

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) 전망의 규칙을 설정하는 방법이 있나요 (많은 가능성을 보았다) 또는 중지 할 Exchange 서버에 뭔가를 이 일이 벌어 지니?

2.) Vba를 사용하면 전자 메일을 보낼 때 서명을 제거하거나 허용하지 않을 수 있습니까?

나의 궁극적 인 목표는 단지 ​​.png가 Mac 사용자와 SpiceWorks에 이미지로 업로드되는 것을 막는 것입니다.

나는이 부분이 더있을 것이라고 확신하지만 나에게 주어진 질문에 기꺼이 대답 할 것입니다.

도움이나 지시를 보내 주셔서 감사합니다.

Answer 1

정확하게 이해하면 SpiceWorks로 보내지는 .png 파일을 제거하려고합니다. 그렇다면 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 

----- 전용 "### 이미지. 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 

-----은 첨부 파일을 제거하는 업데이트 < 10kb이고 "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