如何创建脚本来删除传入电子邮件的正文？答案

【问题标题】：How do I create a script to remove the body of incoming emails?如何创建脚本来删除传入电子邮件的正文？
【发布时间】：2019-03-25 06:53:32
【问题描述】：

我正在尝试创建一个可以与消息规则一起使用的脚本，以删除传入电子邮件的正文。理想情况下，我想保留前 20 个字符并删除电子邮件的其余部分，但我会满足于删除整个内容。

【问题讨论】：

这是一个很奇怪的请求。您是指每封电子邮件的正文还是部分电子邮件的正文？知道谁给你发了邮件而不知道他们写了什么有什么价值？
进一步澄清...
为了进一步澄清......我需要这个的电子邮件帐户接收来自另一个发件人的附件，该附件会自动拉到另一个应用程序。当电子邮件正文中的字符超过 20 个时，该过程将失败。问题是发件人签名。我需要将其删除，以便可以进行提取。在这个阶段，需要手动删除它。
这个发件人的每封电子邮件都有问题还是只有一些？如果只有一些，您能识别出需要删除其正文的电子邮件吗？我认为最简单的方法是确定发件人的规则，然后是删除 Html 正文并将文本正文减少到 20 个字符的脚本。
我发现很难理解保存附件的过程如何受到正文大小的影响。我认为这个问题是因为错误的过程不在你的控制之下，也不容易修复。

标签： vba outlook

【解决方案1】：

我认为这将是一个简单的宏，但我发现不可能完全实现您的要求；但是，我已经取得了一些接近。我没有删除我的诊断代码，所以你可以自己试验一下，也许会发现一系列我没有尝试过的语句。

这是进行更改的宏：

Public Sub ReduceBody(ItemCrnt As Outlook.MailItem)

  Dim ReducedBody As String

  With ItemCrnt

    ' Not all items in Inbox are mail items. It should not be possible for
    ‘ a non-mail-item to reach this macro but check just in case.
    If .Class = olMail Then

      ' I test for a particular subject and a particular sender
      ' Many properties of a mail item can be checked in this way.  Adjust
      ' the If statement as necessary
      If LCase(.Subject) = "attachments" And _
         LCase(.SenderEmailAddress) = "xxxxx.com" Then

        Debug.Print "Html: [" & Replace(Replace(.HtmlBody, vbLf, "{l}"), vbCr, "{r}") & "]"
        Debug.Print "Text: [" & Replace(Replace(.Body, vbLf, "{l}"), vbCr, "{r}") & "]"
        Debug.Print "Format: " & .BodyFormat

        Debug.Assert False   ' Have a look at the initial values of the properties

        ' Save reduced body because clearing the Html body also clears the text body
        ReducedBody = Left$(.Body, 20)
        .BodyFormat = olFormatPlain   ' Set body format to plain text
        .HtmlBody = "<BODY>" & ReducedBody & "</BODY>"

        Debug.Print "Html: [" & .HtmlBody & "]"
        Debug.Print "Text: [" & .Body & "]"
        Debug.Print "Format: " & .BodyFormat

        Debug.Assert False   ' Have a look at the new values of the properties
        .Close (olDiscard)   ' Delete when the new
        Exit Sub                 ‘ values are as you require

        .Save                        ' Save amended mail item
      End If
    End If
  End With

End Sub

我相信我的 cmets 充分解释了宏的结构。

一旦宏确认它传递的项目是它应该处理的项目，它会将 Html 正文、文本正文和正文格式的当前值输出到即时窗口并使用Debug.Assert 停止处理.当您准备好继续时，请单击 F5。

代码修改这三个属性，显示它们的新值并再次停止。

我早就知道 Outlook 会从 Html 正文构建文本正文，但我没有意识到 Html 正文、文本正文和正文格式之间的联系。改变其中任何一个都会改变其他的。我提供的修改代码是我能够创建的最好的代码：

正文 = 原始正文的前 20 个字符
Html body = “” & 原文正文的前 20 个字符 & “”
正文格式 = Html

当您使用 F5 重新启动宏时，更改将被丢弃。除非放弃更改，否则即使您不执行 save 命令，它们也会被保存。保留丢弃语句，直到显示的值可以接受。

为了测试上面的宏，我使用了：

Sub TestReduceBody()

  Dim Exp As Explorer
  Dim ItemCrnt As MailItem

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Please select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      Call ReduceBody(ItemCrnt)
    Next
  End If

End Sub

我使用这样的宏来测试我所有的新邮件，处理宏。选择一个或多个邮件项目，然后启动此宏。这个宏允许我从一个简单的电子邮件开始，只有当它被正确处理时，我才能尝试更复杂的电子邮件。我有几个电子邮件地址，并且我从辅助帐户向我的主帐户发送了合适的测试电子邮件。您将准备好测试的真实电子邮件。我强烈推荐使用这样的宏。

根据您的要求修改第一个宏后，设置规则并将规则链接到此宏。我假设您知道如何创建规则，但如有必要，我可以提供说明。

【讨论】：