Question

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

Answer 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

我相信我的评论可以充分说明宏的结构。

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

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

很长时间以来，我就知道Outlook将根据HTML正文构建文本正文，但我还没有意识到HTML正文，文本正文和正文格式之间的联系。改变其中任何一个都会改变其他。我提供的修改代码是我能够创建的最好的代码：

文本正文=原始文本正文的前20个字符
HTML正文=“”和原始正文的前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

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

在将第一个宏修改为您的要求之后，请设置一条规则并将该规则链接到该宏。我假设您知道如何创建规则，但是如有必要，我可以提供说明。

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

1 个答案: