Mark Multiple Messages as Spam at Once

In Outlook one can mark only single messages as spam. If more than one message is selected, then the Add to blocked senders list command is disabled.

This macro allows to mark multiple messages at once as spam by moving them to a temporary folder.

Since Outlook 16.0.0.8625 the sample doesn´t work anymore because the Commandbar cannot be called anymore.

  How to add macros to Outlook

Public Sub MarkMultipleMessagesAsSpam()
  On Error GoTo ERR_HANDLER
  Dim Exp As Outlook.Explorer
  Dim Bars As Office.CommandBars
  Dim Cmd As Office.CommandBarButton
  Dim Inbox As Outlook.MAPIFolder
  Dim TempFolder As Outlook.MAPIFolder
  Dim CurrFolder As Outlook.MAPIFolder
  Dim Items As Outlook.Items
  Dim Item As Object
  Dim Sel As Outlook.Selection
  Dim cSel As VBA.Collection
  Dim i&, Count&
  Dim Preview As Boolean
  Dim IsOL2010OrHigher As Boolean

  IsOL2010OrHigher = (Left(Application.Version, 2) > 12)
  Set Exp = Application.ActiveExplorer
  Set CurrFolder = Exp.CurrentFolder
  Preview = Exp.IsPaneVisible(olPreview)
  Set Bars = Exp.CommandBars
  If IsOL2010OrHigher = False Then
    Set Cmd = Bars.FindControl(, 9786)
    If Cmd Is Nothing Then Err.Raise 1000, "Cannot find the commandbar button."
  End If
  Set Sel = Exp.Selection
  Count = Sel.Count
  Select Case Count
  Case 0: Err.Raise 1000, , "No message is selected."
  Case 1
    If IsOL2010OrHigher Then
      Bars.ExecuteMso "JunkEmailAddToBlockedSendersList"
    Else
      Cmd.Execute
    End If
  Case Else
    Set cSel = New VBA.Collection
    For Each Item In Sel
      cSel.add Item
    Next
    Set Sel = Nothing
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set TempFolder = Inbox.Folders("temp spam")
    If TempFolder Is Nothing Then
      Set TempFolder = Inbox.Folders.add("temp spam")
    End If
    Set Exp.CurrentFolder = TempFolder
    Exp.ShowPane olPreview, False
    For i = Count To 1 Step -1
      Set Item = cSel(i)
      Item.Move TempFolder
      Set Item = Nothing
      DoEvents
      If TempFolder.Items.Count = 1 Then
        If IsOL2010OrHigher Then
          Bars.ExecuteMso "JunkEmailAddToBlockedSendersList"
        Else
          Cmd.Execute
        End If
      End If
      DoEvents
    Next
    Set Exp.CurrentFolder = CurrFolder
    Exp.ShowPane olPreview, Preview
    If TempFolder.Items.Count = 0 Then
      TempFolder.Delete
    End If
  End Select
  Exit Sub
ERR_HANDLER:
  If Err.Number = &H8004010F Then Resume Next
  MsgBox Err.Description
End Sub