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

时间:2016-04-22 08:38:13

标签: vba outlook-vba

如果所选邮件的Subject,MailBody和FromSenderAddress,我选择任何邮件打开一个新邮件项目,并附上邮件。

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

如何消除签名内容(Thanks..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

1 个答案:

答案 0 :(得分:0)

如果签名中有关键字,总是与“最好的问候”相同,您可以使用:

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

如果您没有关键字或不同关键字,则很难找到签名