从新邮件中删除从旧邮件中复制的签名

Question

我选择任何邮件来打开一个新邮件项，邮件正文由所选邮件的主题、邮件正文和 FromSenderAddress 组成。

我在我的新邮件正文中获得了所选邮件的签名内容。

我如何消除签名内容（谢谢..Regards...xxxxx.etc;）所以它不在我的新邮件正文中。

Public Sub CreateNewMessage()

Dim objMsg As MailItem
Dim Selection As Selection
Dim obj As Object

Set Selection = ActiveExplorer.Selection

For Each obj In Selection

    Set objMsg = Application.CreateItem(olMailItem)

    With objMsg
      .To = ""
      .CC = ""
      .BCC = ""
      .Subject = ""
      .Body = "<Subject> " & obj.Subject & _ 
           " </Subject>" & vbCrLf & vbCrLf & _
           "<Mail> " & obj.Body & " </Mail>" & vbCrLf & vbCrLf & _
           "<Sender> " & obj.SenderEmailAddress & " </Sender>"
      .Sensitivity = olConfidential
      .Display
    End With

    Set objMsg = Nothing
Next
End Sub

Answer 1

如果你在签名中有一个关键字，它总是和“最好的问候”一样，你可以使用这个：

Option Explicit

Sub DeleteAfterText()

' Deletes all text after endStr.

Dim currMail As mailitem
Dim msgStr As String

Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long

Set currMail = ActiveInspector.CurrentItem
endStr = "Best Regards"
endStrLen = Len(endStr)

msgStr = currMail.HTMLBody
endStrStart = InStr(msgStr, endStr)

If endStrStart > 0 Then
    currMail.HTMLBody = Left(msgStr, endStrStart + endStrLen)
End If

End Sub

如果您没有关键字或其他关键字，则可能很难找到签名