Vba 自动删除电子邮件正文中警告的边框

我刚刚遇到了与下面链接的讨论中描述的相同的问题，但有一个陷阱：我的组织在所有外部电子邮件上添加的警告横幅上添加了边框和突出显示

参考讨论：

我已经开发了代码来去除文本，因为HTML源代码对警告横幅的某些部分使用了不同的格式，所以必须将其拆分：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

     Item.HTMLBody = Replace(Item.HTMLBody, "Attention:", "")
     Item.HTMLBody = Replace(Item.HTMLBody, "This email originated from outside the university.", "")

End Sub

这会留下一个空白的横幅，带有棕色边框和棕褐色突出显示。所有这些都是在HTML代码中预先添加到消息中的，但我不知道如何让VBA在HTML级别进行搜索。我想修改上述内容，改为从邮件正文中删除以下HTML：

<div style=3D"border:solid #9C6500 1.0pt;padding:2.0pt 2.0pt 2.0pt 2.0pt">
<p class=3D"MsoNormal" style=3D"line-height:11.0pt;background:#FFEB9C"><b><=
span style=3D"font-size:9.0pt;color:#9C6500">Attention:</span></b><span sty=
le=3D"font-size:9.0pt;color:black"> This email originated from outside the =
university.<o:p></o:p></span></p>

注意：此电子邮件来自=
大学

---

VBA能否在HTML级别进行编辑，即修改源代码？HTML代码的第一行是需要执行的，但我正在努力找到正确的命令。

您需要删除包含此消息的整个块

和

就像一些Html周围的括号，指定

和

之间的所有内容都将被视为块。Html的作者可能出于以下任何一个原因需要创建一个块。在这里，作者希望指定块的外观。所以

yyyy

说将样式

xxxx

应用于

yyy

---

您的问题省略了尾随的

。如果此块出现在邮件的最后，编写此添加代码的人可能忽略了

您是如何从电子邮件中提取此Html块的？我这样问是因为这个Html不是很有效。我怀疑“3D”最初是“3D”。第2、3和4行末尾的“=”不应该在那里。谢谢，是的，我忘了。我从Thunderbird中的源代码视图弹出窗口复制了文本，但我错过了最后一行。它看起来像雷鸟在换行时附加了=。我同意=不应该存在，我在Outlook中有缺少它的源代码视图。3D的东西也是雷鸟的产物。实际的HTML是：
注意：这封电子邮件来自大学以外。
我的大问题是replace命令中的双引号，比如Item.HTMLBody=replace（Item.HTMLBody，“，”）。如果我试图插入HTML代码，其中包含“在它里面，这不起作用。这就是我被卡住的地方。我需要为每一个使用类似&Chr（34）&的东西吗？”？我想如果我能学会如何在字符串中输入双引号，我就能得到这个结果。我缺少了一些我从未学过的语法。如果你想在字符串中加上双引号，你可以加上两个。例如：对于“使用”。试试看；这是一个标准的VBA功能。我仍然认为一次性删除整个块会更容易。
                                                                                                  <di|
|v style='mso-element:para-border-div;border:solid windowtext 1.0pt;padding:1.0pt 4.0pt 1.0pt 4.0pt'>|
|<p class=MsoNormal align=center style='text-align:center;border:none;padding:0cm'><span style='font-|
|family:"inherit",serif;color:#303336;border:none windowtext 1.0pt;padding:0cm;background:aqua;mso-hi|
|ghlight:aqua;mso-fareast-language:EN-GB'>This email originated from outside the university.</span><o|
|:p></o:p></p></div>

Sub RemoveWarning(ByRef ItemCrnt As MailItem)

  Dim LcHtmlBody As String
  Dim PosDivEnd As Long
  Dim PosDivStart As Long
  Dim PosMessage As Long

  With ItemCrnt

    ' Check message contains warning
    PosMessage = InStr(1, .HtmlBody, "This email originated from outside the university.")
    If PosMessage = 0 Then
      ' No message found
      Exit Sub
    End If

    ' Find start and end div
    LcHtmlBody = .HtmlBody   ' Allow for "<DIV" and "<div"
    PosDivStart = InStrRev(LcHtmlBody, "<div", PosMessage)
    PosDivEnd = InStr(PosMessage, LcHtmlBody, "</div>")
    If PosDivStart = 0 Or PosDivEnd = 0 Then
      ' Start div or end div or both not found
      Exit Sub
    End If

    ' Delete Div block from Html
    .HtmlBody = Mid$(.HtmlBody, 1, PosDivStart - 1) & Mid$(.HtmlBody, PosDivEnd + 6)

  End With

End Sub