Outlook Junk Mail - Old

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