Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

forward message BUT keep headers?

Status
Not open for further replies.

msc0tt

IS-IT--Management
Jun 25, 2002
281
0
0
CA
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. I'm not sure what you mean by headers. There is a property named Subject you can access. Try something like this to pick up the old subject:

newMsg.Subject = .Subject

2. To permanently delete it try something like the following after you have deleted it - You may have to check some properties to ensure you have the right item so pass the mail item in as a parameter:

Private Sub DeleteAll(MyNameSpace As NameSpace, _
MyMailItem As MailItem)
Dim mf As MAPIFolder
Dim mi As MailItem
Set mf = _
MyNameSpace.GetDefaultFolder(olFolderDeletedItems)
Set mi = mf.Items(1)
mi.Delete
Set mf = _
MyNameSpace.GetDefaultFolder(olSentItems)
Set mi = mf.Items(1)
mi.Delete
Set mf = Nothing
Set mi = Nothing
End Sub

Good Luck!

Have a great day!

j2consulting@yahoo.com
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top