VBA - 側重於錯誤電子郵件的Outlook腳本

下面是我從其他許多來源拼湊出來的腳本。每當新電子郵件通過Microsoft Outlook 2013中的電子郵件規則到達時，它都會觸發。該腳本應該查看傳入的電子郵件並去除頁面背景。VBA - 側重於錯誤電子郵件的Outlook腳本

實際情況是，我得到了一個小小的彈出窗口，說新的郵件已經到達，它將刪除電子郵件的背景，這已經成爲Outlook的焦點！因此，如果我點擊具有html背景的電子郵件，以便它是預覽窗格的焦點，然後收到一封新電子郵件，它將刪除該重點郵件的背景......很棒......但是我希望它能檢查新到的信息！

任何想法？

Sub CustomMailMessageRule(Item As Outlook.MailItem) 
    MsgBox "Mail message arrived: " & Item.Subject 
    Call ClearStationeryFormatting 
End Sub 

Sub ClearStationeryFormatting() 
On Error GoTo ClearStationeryFormatting_Error 
    Dim strEmbeddedImageTag As String 
    Dim strStyle As String 
    Dim strReplaceThis As String 
    Dim intX As Integer, intY As Integer 
    Dim myMessage As Outlook.MailItem 

    ' First, check to see if we are in preview-pane mode or message-view mode 
    ' If neither, quit out 
    Select Case TypeName(Outlook.Application.ActiveWindow) 
     Case "Explorer" 
      Set myMessage = ActiveExplorer.Selection.Item(1) 
     Case "Inspector" 
      Set myMessage = ActiveInspector.CurrentItem 
     Case Else 
      MsgBox ("No message selected.") 
      Exit Sub 
    End Select 

    ' Sanity check to make sure selected message is actually a mail item 
    If TypeName(myMessage) <> "MailItem" Then 
     MsgBox ("No message selected.") 
     Exit Sub 
    End If 

    ' Remove attributes from <BODY> tag 
    intX = InStr(1, myMessage.HTMLBody, "<BODY", vbTextCompare) 
    If intX > 0 Then 
     intY = InStr(intX, myMessage.HTMLBody, ">", vbTextCompare) 
     strReplaceThis = Mid(myMessage.HTMLBody, intX, intY - intX + 1) 
    End If 

    If strReplaceThis <> "" Then 
     myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "<BODY>") 
     strReplaceThis = "" 
    Else 
     Err.Raise vbObjectError + 7, , "An unexpected error occurred searching for the BODY tag in the e-mail message." 
     Exit Sub 
    End If 

    ' Find and replace <STYLE> tag 
    intX = InStr(1, myMessage.HTMLBody, "<STYLE>", vbTextCompare) 
    If intX > 0 Then 
     intY = InStr(8, myMessage.HTMLBody, "</STYLE>", vbTextCompare) 
     strReplaceThis = Mid(myMessage.HTMLBody, intX, ((intY + 8) - intX)) 
    End If 

    If strReplaceThis <> "" Then 
     myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "") 
    End If 

    If InStr(1, myMessage.HTMLBody, "<center><img id=", vbTextCompare) > 0 Then 
     strEmbeddedImageTag = "<center><img id=" 
     '"<center><img id=""ridImg"" src="citbannA.gif align=bottom></center>" 
     intX = InStr(1, myMessage.HTMLBody, strEmbeddedImageTag, vbTextCompare) 
     If intX = 0 Then 
      Err.Raise vbObjectError + 8, , "An unexpected error occurred searching for the embedded image file name start tag in the e-mail message." 
      Exit Sub 
     End If 
     intY = InStr(intX + Len(strEmbeddedImageTag), myMessage.HTMLBody, " align=bottom></center>", vbTextCompare) 
     If intY = 0 Then 
      Err.Raise vbObjectError + 9, , "An unexpected error occurred searching for the embedded image file name end tag in the e-mail message." 
      Exit Sub 
     End If 
     strEmbeddedImageTag = Mid(myMessage.HTMLBody, intX, intY - intX) 
     intX = InStr(1, myMessage.HTMLBody, "<CENTER>", vbTextCompare) 
     intY = InStr(intX, myMessage.HTMLBody, "</CENTER>", vbTextCompare) 
     strReplaceThis = Mid(myMessage.HTMLBody, intX, intY - intX) & "</CENTER>" 
     myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "", , , vbTextCompare) 
    End If 

    ' Finally, saved modified message 
    myMessage.Save 

    On Error GoTo 0 
    Exit Sub 

ClearStationeryFormatting_Error: 

    MsgBox "Error " & Err.Number & " (" & Err.Description & ")" 
    Resume Next 
End Sub

來源

2017-05-23 Jack

遺憾的是，劇本似乎打破進出格式。 – Jack

你應該能夠通過你要處理作爲參數的郵件項目，即

Sub CustomMailMessageRule(Item As Outlook.MailItem) 
    MsgBox "Mail message arrived: " & Item.Subject 
    ClearStationeryFormatting Item 
End Sub 

Sub ClearStationeryFormatting(myMessage As Outlook.MailItem) 
    On Error GoTo ClearStationeryFormatting_Error 
    Dim strEmbeddedImageTag As String 
    Dim strStyle As String 
    Dim strReplaceThis As String 
    Dim intX As Integer, intY As Integer 

    ' Remove attributes from <BODY> tag 

    '...

來源

2017-05-23 04:45:43 YowE3K

感謝您的快速回復，並重新格式化原文。我做了這個確切的改變，但奇怪的是它沒有任何區別。 – Jack

我已經刪除了案例切換，現在它完美的工作！感謝您的輸入:-) – Jack

VBA - 側重於錯誤電子郵件的Outlook腳本

回答

相關問題