将当前消息转发为附件,然后删除原始消息

时间:2013-01-29 18:00:54

标签: vba outlook-vba outlook-2010

我的工作Outlook 2010帐户上收到了大量垃圾邮件。我收到了垃圾邮件阻止程序地址,以便将垃圾邮件(作为附件)转发给。

我想点击功能区上的图标(我已经拥有此功能)并运行VBA代码以获取当前消息,将其附加到新消息,为新消息添加地址,发送新消息消息然后删除原始消息。 (删除可以将邮件放在“已删除邮件”文件夹中,也可以永久删除。)

已解决!!!!

这是完全符合我要求的代码。我在网上找到它并对其进行修改以满足我的需求。

Sub ForwardAndDeleteSpam()
'
' Takes currently highlighted e-mail, sends it as an attachment to
' spamfilter and then deletes the message.
'

    Set objItem = GetCurrentItem()
    Set objMsg = Application.CreateItem(olMailItem)

    With objMsg
        .Attachments.Add objItem, olEmbeddeditem
        .Subject = "SPAM"
        .To = "spamfilter@schools.nyc.gov"
        .Send
    End With
    objItem.Delete

    Set objItem = Nothing
    Set objMsg = Nothing
End Sub

Function GetCurrentItem() As Object
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
        Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
        Set GetCurrentItem = Application.ActiveInspector.CurrentItem
    Case Else
        ' anything else will result in an error, which is
        ' why we have the error handler above
    End Select

    Set objApp = Nothing
End Function

1 个答案:

答案 0 :(得分:0)

你可以使用它来浏览一系列电子邮件,而不仅仅是通过调整代码如下所示

Sub ForwardSpamToNetworkBox()

On Error Resume Next

Dim objItem As Outlook.MailItem

If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item selected")
   Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
Set objMsg = Application.CreateItem(olMailItem)
    With objMsg
        .Attachments.Add objItem, olEmbeddeditem
        .Subject = "SPAM"
        .To = "spam@host.co.uk"
        .Send
    End With
objItem.Delete
Next

Set objItem = Nothing
Set objMsg = Nothing

End Sub

这是使用http://jmerrell.com/2011/05/21/outlook-macros-move-email

中的信息创建的

理想情况下,我会将其移至名为“已提交”的子文件夹,而不是删除,但我无法在公共文件夹中使用