Spamcop ReportSpam Macro for Outlook

 

This macro runs on Microsoft Outlook (not Outlook Express).  Just follow the instructions below to install this in your copy of Outlook.

'Spamcop.ReportSpam Macro by Ryan Hayle
'Automatically forwards emails with full headers and HTML Source to SpamCop
'Released in the public domain

'Based on SpamSource 1.01a Beta by Chris Price
'http://www.daesoft.com/freeware/spamsource/
'Includes source examples from "VB Script Code Sample #54 - Find a Text File
'and Mail It" by Helen Feddema (hfeddema)

'Modifications by Leon Mayne, July 2003
'http://www.uea.ac.uk/~l003/olspamcop/
'This is version 1.5 of this rewrite.

'Further modifications by Robert Sewell, November, 2003
'These mods cause the macro to:
' * handle one or more spams without having to open them
' * always forward the spam as text rather than an attachment
'http://www.freewebs.com/7wells/visbas/source/reportspam

'Installation Instructions:
'1) If you do not have Outlook's CDO installed:
' a) Start the Office 2000 setup program.
' b) Click Add or Remove Features
' c) Expand the list of features for Outlook by clicking on the + symbol
' next to Microsoft Outlook for Windows
' d) Click on the icon next to 'Collaboration Data Objects' and select
' 'Run from My Computer' from the menu that appears
' e) Click on 'Update Now'
'
'2) Open Outlook and select Tools / Macro / Visual Basic Editor
'3) Select File / Import file
'4) Browse to the location of this file (olspamcop.bas), select it, and click open
'5) Select Tools / References and check the boxes next to:
' 'Microsoft HTML Object Library'
' 'Microsoft CDO 1.2.1 Library'
' 'Microsoft Forms 2.0 Object Library'
' If 'Microsoft Forms 2.0 Object Library' is not listed, click 'browse' and
' add the file 'FM20.DLL' which will either be in C:/Windows/System32/
' or C:\WINDOWS\SYSTEM\FM20.DLL depending on your windows version.
' If 'Microsoft CDO 1.2.1 Library' is not listed, see installation point 1
'6) If you are using the SpamCop reporting feature, Change the value of
' SPAMCOP_ADDRESS in the line of code beginning with
' 'Public Const SPAMCOP_ADDRESS' to the email address Spamcop gave you
' when you signed up. Change the other config lines below it if required.
'6a) For a nicer look, you may want to change the project name to something
' other than 'Project1'. I use 'myMacros'.
'7) Click File / Save [project name]
'8) Select File / Close and return to Microsoft Outlook
'
'Changing Macro protection level:
'You may have to change your macro protection level to medium, because
'the macro will not run at all if it is set to high. To do this:
'1) Click Tools / Macro / Security
'2) Set the level to medium and click OK.
'
'Creating a button to click:
'1) In Outlook, Click Tools / Customize
'2) Click on the 'Commands' tab
'3) In the 'Categories' list, select 'Macros'
'4) Drag 'Project1.reportSpam' (or 'myMacros.ReportSpam') to
' somewhere on the toolbar (e.g. next to
' the Forward button)

'Done! Now, when you open a spam email, you can just click your
'button, select 'Yes' to the security dialogs that pop up, and then
'wait for the verification email from Spamcop.

'NOTE: If you are using Outlook 2000 or below, you need to set
'your default message format to plain text. You can change this in
'tools/options/mail format

'Further installation Instructions (from SpamSource) available at:
'http://www.daesoft.com/freeware/spamsource/installation.html

Sub ReportSpam()
  Const SPAMCOP_ADDRESS = "submit.yourSpamcopKeyHere@spam.spamcop.net"
  Const ASKVERIFY = False 'Set to true to ask if the user is sure (only for reportSpam)
  Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E
  Dim oIExplorer As HTMLDocument
  Dim oItem As MailItem, oForwardItem As MailItem
  Dim oMessage As Message
  Dim oNS As NameSpace
  Dim oSelection As Selection
  Dim oSession As Session
  Dim sMsg As String, sHeader As String, sBody As String, sEntry As String
  Dim iIdx As Integer, iLoop As Integer
  Dim dtDeferDate As Date
 
  Set oNS = Application.GetNamespace("MAPI")
  Set oSelection = oNS.GetDefaultFolder(olFolderInbox).Application.ActiveExplorer.Selection
 
  If ASKVERIFY Then
  If MsgBox("Are you sure you want to report these emails as spam?", _
  vbYesNo + vbQuestion, "Spamcop") = vbNo Then Exit Sub
  End If
 
  'make sure at least one email message is highlighted/selected
  If oSelection.Count > 0 Then
  'defer delvery time so that any anti-virus program's outbound scan
  'won't get overwhelmed and lock up
  dtDeferDate = DateAdd("s", 5 + oSelection.Count, Now)
  'operate on each selected email message, one at a time
  For Each oItem In oSelection
  'Ensure selected item is an email message
  If oItem.Class = olMail Then
  sEntry = oItem.EntryID
  Set oSession = CreateObject("MAPI.Session")
  oSession.Logon "", "", False, False
 
  'get an MAPI reference to the email
  Set oMessage = oSession.GetMessage(sEntry)
 
  'get the header
  sHeader = oMessage.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS)
 
  'get the body of the message
  If oItem.GetInspector.EditorType = olEditorHTML Then
  Set oIExplorer = oItem.GetInspector.HTMLEditor
  DoEvents 'to stop the occasional error
  sMsg = oIExplorer.documentElement.outerHTML
  Else
  sMsg = oItem.Body
  End If
 
  'set the body of the message to be forwarded to SpamCop
  sBody = sHeader + sMsg
 
  'create a new email message to be forwarded to SpamCop
  Set oForwardItem = Application.CreateItem(olMailItem)
  With oForwardItem
  .Recipients.Add SPAMCOP_ADDRESS
  .Subject = "Spam Report"
  .Body = sBody
  .DeleteAfterSubmit = True
  .DeferredDeliveryTime = dtDeferDate
  .Send
  End With
  DoEvents
  oItem.UnRead = False
  oItem.Delete
 
  'clean up the objects
  Set oForwardItem = Nothing
  Set oIExplorer = Nothing
  Set oMessage = Nothing
  Set oSession = Nothing
  'take a look at what was sent
  'Debug.Print sBody
  Else
  MsgBox "This macro only works on email messages."
  End If
  Next
  End If
  Set oSelection = Nothing
  Set oNS = Nothing
End Sub

Home

Problems? Comments?  Send me e-mail at .

This site is hosted for FREE by Freewebs.com. Click here to get your own Free Website!