0

因此,我偶然發現了一個有趣的問題。通過向SpiceWorks和Mac用戶發送電子郵件,我遇到了問題。從Outlook電子郵件中刪除簽名/附件到Mac用戶或SpiceWorks

當用戶遇到問題時,他們會通過電子郵件發送幫助臺。我們設置了個人Outlook電子郵件來處理幫助臺門票。一旦票據打到Outlook郵箱,它將自動發送到我們的SpiceWorks站點。

現在我們所有的電子郵件都有簽名,並且有一些帶有小圖片徽標(Youtube,LinkedIn,Facebook和Twitter)的簽名。 當電子郵件到達SpiceWorks時,它會將這些png圖像作爲附件上傳。這些附件會導致大部分問題,因爲某些電子郵件線程在提交作爲幫助臺票證之前會變得很長。他們最終可能會有20個附件中的相同的四個標誌PNG的附件。

我編碼刪除所有附件到該特定地址,但一些用戶發送實際附件。我試圖通過名稱刪除特定的附件,但如果有重複的相同的.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 Server做點什麼來阻止這發生了什麼?

2.)有了VBA有辦法刪除或不允許簽名時,電子郵件發送?

如果有什麼,我的最終目標是阻止那些.png被上傳爲Mac用戶和SpiceWorks的圖像。

我確信還有更多,但我會很樂意回答給我的任何問題。

感謝您的幫助或指導!

回答

1

如果我正確理解你,你正在嘗試刪除發送給SpiceWorks的.png文件。如果是這樣,請使用下面的宏從Outlook郵箱發送到SpiceWorks。在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 
+0

這在某種程度上可行。問題在於用戶喜歡使用剪切工具並上傳圖片(大多數是.png),因此這會使用.png完全刪除所有附件。 – JayBec

+0

只有當它們附着在身體當然。 – JayBec

+0

查看上面更新的代碼。此解決方案只會移除看起來像「image ###。png」的附件。 – phillip3196772

相關問題