I've got a macro that users run to 'process' spam messages they receive in Outlook 2000. The end goal for the macro is to:
1) forward the message to a special account (AND retain the headers in the new message).
2) permanently delete the message.
I'm getting there, but a few refinements are needed.
1) I don't know how to preserve the header when a message is forwarded.
2) I'd like to 'permanently' delete the spam message (not in Deleted Items, and not in Sent Items).
My code so far comes from another macro that did similar message processing. I am new to programming with the Outlook Module, so please advise if I could do something better.
-with thanks,
Mike
Option Explicit
Const sSpamEmail = "knownspam@mycompany.com"
Sub reportSpam()
Dim objApp As Outlook.Application
Dim objSel As Outlook.Selection
Dim newMsg As Outlook.MailItem
Dim x As Integer
' Find the currently selected emails
Set objApp = CreateObject("Outlook.Application"
Set objSel = objApp.ActiveExplorer.Selection
' For each message selected
For x = 1 To objSel.Count
With objSel.Item(x)
' perform save only on selected mail messages
If .Class = olMail Then
' forward msg to spam bin
Set newMsg = .Forward
newMsg.Recipients.Add sSpamEmail
newMsg.Send
.Delete
End If
End With
Next x
' cleanup
Set objSel = Nothing
Set objApp = Nothing
Exit Sub
End Sub
1) forward the message to a special account (AND retain the headers in the new message).
2) permanently delete the message.
I'm getting there, but a few refinements are needed.
1) I don't know how to preserve the header when a message is forwarded.
2) I'd like to 'permanently' delete the spam message (not in Deleted Items, and not in Sent Items).
My code so far comes from another macro that did similar message processing. I am new to programming with the Outlook Module, so please advise if I could do something better.
-with thanks,
Mike
Option Explicit
Const sSpamEmail = "knownspam@mycompany.com"
Sub reportSpam()
Dim objApp As Outlook.Application
Dim objSel As Outlook.Selection
Dim newMsg As Outlook.MailItem
Dim x As Integer
' Find the currently selected emails
Set objApp = CreateObject("Outlook.Application"
Set objSel = objApp.ActiveExplorer.Selection
' For each message selected
For x = 1 To objSel.Count
With objSel.Item(x)
' perform save only on selected mail messages
If .Class = olMail Then
' forward msg to spam bin
Set newMsg = .Forward
newMsg.Recipients.Add sSpamEmail
newMsg.Send
.Delete
End If
End With
Next x
' cleanup
Set objSel = Nothing
Set objApp = Nothing
Exit Sub
End Sub