专注于错误电子邮件的脚本

debugcn 发表于 Dev

杰克

下面是我从许多其他来源拼凑而成的脚本。每次通过 Microsoft Outlook 2013 中的电子邮件规则收到新电子邮件时，它都会触发。

该脚本应该查看传入的电子邮件并去除页面背景。

发生的事情是我收到一个弹出窗口，说新邮件已经到达，它会去掉 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

YoE3K

您应该能够将要处理的邮件项目作为参数传递，即

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

    '...

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。