从转发的电子邮件 VBA 宏中删除自动签名

Question

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

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

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

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

代码如下：

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 "bcc.hwb@gmail.com"
    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 代码的帮助将不胜感激。

Answer 1

当您分配一个 VBA 宏子以按规则运行时，您将获得 MailItem 对象的一个​​实例。例如：

 Sub Incoming3(MyMail As MailItem)

MyMail 对象表示您应该在代码中使用的传入电子邮件。但我看到你得到了一个新实例：

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

没有必要这样做。在代码中使用 MyMail 对象。

我还看到以下代码：

 Set objBkm = objDoc.Bookmarks("_MailAutoSig")

尝试在调试器下运行代码，看看是否能找到书签。如果没有这样的书签，您需要在正文中搜索第一个条目 From: 并删除该关键字之前的所有内容。

最后，您可能会发现 MSDN 中的 Getting Started with VBA in Outlook 2010 文章很有帮助。

Answer 2

在 DeleteSig 中处理错误的邮件。

myItem.DeleteAfterSubmit = True

Call DeleteSig(myItem)

myItem.Send

编辑 2015 02 26

Debugging VBA Code

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 "bcc.hwb@gmail.com"
    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 - 结束