Mehrere Emails gleichzeitig als Spam markieren

In Outlook können Sie immer nur eine E-Mail zur Zeit als Spam markieren. Wenn Sie dagegen mehr als eine E-Mail auswählen, dann ist der Menüpunkt Absender zur Liste blockierter Absender hinzufügen nicht mehr wählbar.

Dieses Makro umgeht die Einschränkung, indem alle markierten Nachrichten zuerst in einen temporären Ordner verschoben werden.

Das Beispiel funktioniert nicht mehr ab Outlook 16.0.0.8625, da die Commandbar nicht mehr aufgerufen werden kann.

  So fügen Sie Makros in Outlook ein

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, "Schaltfläche nicht gefunden"
  End If
  Set Sel = Exp.Selection
  Count = Sel.Count
  Select Case Count
  Case 0: Err.Raise 1000, , "Keine Nachricht ausgewählt"
  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