The following code worked for older versions of Outlook (2000 I believe), but does not work for newer versions. There used to be a junk button on the toolbar. The code effectively activated that button. I’m not sure how to do it in newer version of Outlook. I have actually given up on Outlook’s spam filtering and use SpamAssassian now. You might check out Wininspector to track down the right object.
If anyone figures out a solution, please email me know. I have had several people ask about this.
This code combines the frequently used steps of adding the senders of all selected e-mails to the Outlook “Junnk Sender’s List” and then moving the messages to the junk mail folder. I then create a toolbar button associated with this “macro.”
The core of which is based on code from Sue Mosher’s article in Windows & .Net Magazine and the kludge to access the unpublished “Add to Junk Senders” is from Rick Pearce’s post to the microsoft.public.outlook.program_vba newsgroup.
' Copyright under GPL by Mark Grimes Sub DealJunkMail() Dim objApp As Application Dim objSelection As Selection Dim blnDoIt As Boolean Dim intMaxItems As Integer Dim intOKToExceedMax As Integer Dim strMsg As String ' ### set your maximum selection size here ### intMaxItems = 5 Set objApp = CreateObject("Outlook.Application") Set objSelection = objApp.ActiveExplorer.Selection Select Case objSelection.Count Case 0 strMsg = "No items were selected" MsgBox strMsg, , "No selection" blnDoIt = False Case Is > intMaxItems strMsg = "You selected " & _ objSelection.Count & " items. " & _ "Do you really want to process " & _ "that large a selection?" intOKToExceedMax = MsgBox( _ Prompt:=strMsg, _ Buttons:=vbYesNo + vbDefaultButton2, _ Title:="Selection exceeds maximum") If intOKToExceedMax = vbYes Then blnDoIt = True Else blnDoIt = False End If Case Else blnDoIt = True End Select If blnDoIt = True Then ' ### set the procedure to run on the selection here ### Call AddToJunkAndMove(objSelection) Beep ' alert the user that we're done 'MsgBox "All done!", , "Selection" End If Set objSelection = Nothing Set objApp = Nothing End Sub Sub AddToJunkAndMove(objSel As Selection) Dim objItem As Object Dim objNS As NameSpace Dim objDestFolder As MAPIFolder Dim myOlApp As Outlook.Application Set objNS = Application.GetNamespace("MAPI") Set objDestFolder = objNS.Folders.Item("Mailbox - Mark Grimes").Folders.Item("Junk E-mail") Set myOlApp = CreateObject("Outlook.Application") Dim ctl As CommandBarControl ' Junk E-mail flyout menu Dim subctl As CommandBarControl ' Add to Junk Senders list menu Set ctl = myOlApp.ActiveExplorer.CommandBars.FindControl(Type:=msoControlPopup, ID:=31126) Set subctl = ctl.CommandBar.Controls(1) 'MsgBox subctl.Caption subctl.Execute For Each objItem In objSel If objItem.Class = olMail Then objItem.Move objDestFolder End If Next Set objDestFolder = Nothing Set objNS = Nothing Set objItem = Nothing End Sub