从转发的电子邮件 VBA 宏中删除自动签名 [英] Delete automatic Signature from forwarded emails VBA macro

问题描述

新手 Outlook VBA.中级 Excel VBA.Windows 7 专业版、Outlook 2010

Newbie Outlook VBA. intermediate Excel VBA. Windows 7 Professional, Outlook 2010

我有一个根据规则运行的脚本，该规则自动转发所有传入的电子邮件.我通常需要它，否则它不会在 Outlook 加载时转发队列中的邮件.

I have a script running from a rule that autoforwards all incoming emails. I need it as a rule because otherwise it will not forward the mails in the queue when Outlook loads.

我希望在转发邮件时删除默认签名.由于答复是空白"，因此没有必要附加 sig.我从 MSDN 站点找到了一些据称可以在 Outlook 2007 中工作的代码.它编译没有错误，执行没有错误.我在 VBA 中引用了 MS Word.但转发的邮件都附有签名.

I would like to have the default signature deleted when the mails are forwarded. As the reply is "blank" it is unnecessary to have the sig appended. I have found some code that supposedly worked in Outlook 2007 from the MSDN site. It compiles no errors, executes no errors. I have referenced MS Word in VBA. But the forwarded emails all have the signature still attached.

我不能只删除签名，因为我需要它在回复中出现.签名开关用于回复和转发邮件.

I cannot just delete the signature because I need it to be there on replies. The switch for the signature is for both replies and forwarded mail.

代码如下:

Option Explicit
Sub Incoming3(MyMail As MailItem)
    Dim strID As String
    Dim strSender As String
    Dim StrSubject As String
    Dim objItem As Outlook.MailItem
    Dim myItem As Outlook.MailItem

    strID = MyMail.entryID
    Set objItem = Application.Session.GetItemFromID(strID)

    strSender = objItem.SenderName
    StrSubject = objItem.Subject
    StrSubject = strSender + ": " + StrSubject
    objItem.Subject = StrSubject
    objItem.AutoForwarded = False

    Set myItem = objItem.Forward

    myItem.Recipients.Add "[e-mail]"
    myItem.DeleteAfterSubmit = True

    Call DeleteSig(objItem)

    myItem.Send

    Set myItem = Nothing
    Set objItem = Nothing

End Sub


Sub DeleteSig(msg As Outlook.MailItem)

    Dim objDoc As Word.Document
    Dim objBkm As Word.Bookmark

    On Error Resume Next

    Set objDoc = msg.GetInspector.WordEditor

    Set objBkm = objDoc.Bookmarks("_MailAutoSig")

    If Not objBkm Is Nothing Then
        objBkm.Select
        objDoc.Windows(1).Selection.Delete
    End If

    Set objDoc = Nothing
    Set objBkm = Nothing

End Sub

对 Outlook 或 VBA 代码的任何帮助将不胜感激.

Any help with Outlook or VBA code would be much appreciated.

推荐答案

在 DeleteSig 中处理错误的邮件.

Processing the wrong mail in DeleteSig.

myItem.DeleteAfterSubmit = True

Call DeleteSig(myItem)

myItem.Send

编辑 2015 02 26

Edit 2015 02 26

调试 VBA 代码

Private Sub Incoming3_test()
' Open a mailitem then click F8 repeatedly from this code    
    Dim currItem As MailItem
    Set currItem = ActiveInspector.currentItem
    Incoming3 currItem        
End Sub

Sub Incoming3(MyMail As MailItem)        
    Dim myItem As Outlook.MailItem        
    Set myItem = MyMail.Forward            
    myItem.Subject = MyMail.senderName & ": " & MyMail.Subject
    myItem.Recipients.Add "[e-mail]"
    myItem.DeleteAfterSubmit = True

    myItem.Display  ' If you are using F8 you can
                    '   view the action taken in DeleteSig.
                    '  Delete the line later.

    Call DeleteSig(myItem)
    'myItem.Send

    Set myItem = Nothing

End Sub

Sub DeleteSig(msg As Outlook.MailItem)

    Dim objDoc As Word.Document
    Dim objBkm As Word.Bookmark

    On Error Resume Next    '<--- Very bad without On Error GoTo 0
    Set objDoc = msg.GetInspector.WordEditor
    Set objBkm = objDoc.Bookmarks("_MailAutoSig")
    On Error GoTo 0

    If Not objBkm Is Nothing Then
        objBkm.Select                       ' <--- This is where the action starts.
        objDoc.Windows(1).Selection.Delete
    End If

    Set objDoc = Nothing
    Set objBkm = Nothing

End Sub

编辑 2015 02 26 - 结束

Edit 2015 02 26 - End

这篇关于从转发的电子邮件 VBA 宏中删除自动签名的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！