如何在SENT文件夹Outlook 2010 Exchange中删除自动转发的电子邮件

时间:2015-02-13 23:15:27

标签: vba email outlook

使用Outlook VBA的新手海报。中级Excel VBA编码器。

我有一个VBA例程,可以将所有传入的电子邮件自动转发到Gmail帐户。它不是我的所有代码,(从博客文章修改)但它的工作原理。我需要保留我在所有帐户中收到的所有电子邮件的副本,以便我可以将它们整合到一个主要帐户中。在Outlook 2010 Exchange帐户中,所有转发的邮件都作为副本保存在SENT文件夹中。

是否可以删除SENT文件夹中的自动转发副本,而不删除所有SENT电子邮件?我需要保留我实际回复的电子邮件。

在INBOX中使用对话模式我不会有问题,将回复的电子邮件存储起来。但是现在看来,当我切换INBOX的对话模式时,由于SENT文件夹中的密件抄送副本,所有内容都会重复。

提前感谢您的任何帮助。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
        Dim objRecip As Recipient
        Dim strMsg As String
        Dim res As Integer
        Dim strBcc As String
        On Error Resume Next

        ' #### USER OPTIONS ####
        ' address for Bcc -- must be SMTP address or resolvable
        ' to a name in the address book
        strBcc = "bcc.hwb@gmail.com"

        Set objRecip = Item.Recipients.Add(strBcc)
        objRecip.Type = olBCC
        If Not objRecip.Resolve Then
            strMsg = "Could not resolve the Bcc recipient. " & _
                     "Do you want still to send the message?"
            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                    "Could Not Resolve Bcc Recipient")
            If res = vbNo Then
                Cancel = True
            End If
        End If

        Set objRecip = Nothing
    End Sub

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim varEntryIDs
    Dim objItem
    Dim myItem As MailItem
    Dim i As Integer
    varEntryIDs = Split(EntryIDCollection, ",")
    For i = 0 To UBound(varEntryIDs)
        Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
        'MsgBox (varEntryIDs(i))

        Set myItem = objItem.Forward
        myItem.Recipients.Add "bcc.hwb@gmail.com"
        myItem.Send

        'myItem.Delete

        Set myItem = Nothing
    Next
End Sub

1 个答案:

答案 0 :(得分:1)

请参阅MailItem.DeleteAfterSubmit Property (Outlook)

myItem.DeleteAfterSubmit = True