Junk-Mail-Ordner automatisch leeren

Um den Inhalt des Junk-Mail-Ordners automatisiert beim Beenden zu löschen (ähnlich wie den Ordner Gelöschte Objekte) gibt es keine Option in Outlook®, weswegen etwas Programmcode benötigt wird. Das Beispiel geht davon aus, dass nur als SPAM gekennzeichnete E-Mails gelöscht werden. Gegebenenfalls müssen Sie noch die Erkennungswerte in der Funktion "IsSPAM" an Ihre Bedürfnisse anpassen.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in das Modul DieseOutlookSitzung kopieren.

Ab Outlook® 2003

Option Explicit
 
Private Sub Application_Quit()
 
    '=====================================================================
    ' Löscht Eelemente aus dem Junk-Mail-Ordner
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-12-17 Version 1.0.0
    ' 2009-07-14 Version 2.0.0
    ' 2011-02-11 Version 2.1.0
    ' 2011-02-13 Version 2.1.1
    '=====================================================================
 
    Dim objJunk As Outlook.MAPIFolder   ' Junk-Mail-Ordner
    Dim objTrash As Outlook.MAPIFolder  ' Ordner "Gelöschte Objekte"
    Dim objItems As Outlook.Items       ' Elemente eines Ordners
    Dim objItem As Object               ' Einzelnes Element
 
    Dim lngLoop As Long                 ' Schleifenzähler
    Dim blnDeleteAll As Boolean         ' Gesamten Ordnerinhalt leeren
    Dim blnKill As Boolean              ' Merker, ob endgültig löschen
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Alle Elemente aus dem Ordner löschen? True = Ja
    '---------------------------------------------------------------------
    blnDeleteAll = False
 
    '---------------------------------------------------------------------
    ' Soll das Element nach dem Löschen auch aus dem Ordner "Gelöschte Ob-
    ' jekte" gelöscht werden? True = endgültig löschen
    '---------------------------------------------------------------------
    blnKill = False
 
    '---------------------------------------------------------------------
    ' Junk-Mail-Ordner referenzieren
    '---------------------------------------------------------------------
    Set objJunk = Outlook.Session.GetDefaultFolder(olFolderJunk)
 
    '---------------------------------------------------------------------
    ' Alle Elemente im Ordner referenzieren
    '---------------------------------------------------------------------
    Set objItems = objJunk.Items
 
    '---------------------------------------------------------------------
    ' Alle Elemente bearbeiten
    '---------------------------------------------------------------------
    For lngLoop = objItems.Count To 1 Step -1
 
        '-----------------------------------------------------------------
        ' Einzelnes Element referenieren
        '-----------------------------------------------------------------
        Set objItem = objItems(lngLoop)
 
        '-----------------------------------------------------------------
        ' Handelt es sich um SPAM bzw. sollen alle Elemente gelöscht werden?
        '-----------------------------------------------------------------
        If IsSPAM(objItem.Subject) Or blnDeleteAll Then
            objItem.UnRead = False
            objItem.Delete
        End If
 
    Next
 
    '---------------------------------------------------------------------
    ' Gelöschte Elemente endgültig löschen?
    '---------------------------------------------------------------------
    If blnKill Then
 
        '-----------------------------------------------------------------
        ' Ordner "Gelöschte Objekte" (Papierkorb) referenzieren
        '-----------------------------------------------------------------
        Set objTrash = Outlook.Session.GetDefaultFolder(olFolderDeletedItems)
 
        '-----------------------------------------------------------------
        ' Alle Elemente im Ordner referenzieren
        '-----------------------------------------------------------------
        Set objItems = objTrash.Items
 
        '-----------------------------------------------------------------
        ' Elemente löschen
        '-----------------------------------------------------------------
        For lngLoop = objItems.Count To 1 Step -1
 
            '-------------------------------------------------------------
            ' Einzelnes Element referenieren
            '-------------------------------------------------------------
            Set objItem = objItems(lngLoop)
 
            '-------------------------------------------------------------
            ' War es eine gelöschte E-Mail?
            '-------------------------------------------------------------
            If IsSPAM(objItem.Subject) Or blnDeleteAll Then objItem.Delete
 
       Next
 
    End If
 
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objItem = Nothing
    Set objItems = Nothing
    Set objJunk = Nothing
    Set objTrash = Nothing
 
End Sub
 
Private Function IsSPAM(ByVal strSubject As String) As Boolean
 
    '=====================================================================
    ' Gibt wahr zurück, wenn eine SPAM-E-Mail erkannt wurde
    '=====================================================================
 
    Dim arySPAM() As String             ' Feld mit Erkennungswerten
    Dim strSPAM As String               ' String für Erkennungswerte
    Dim lngLoop As Long                 ' Schleifenzähler
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Betreff muss folgendes beinhalten, um Element als SPAM zu behandeln
    ' (mehrere Werte durch ; trennen)
    '---------------------------------------------------------------------
    strSPAM = "*** SPAM ***;[Spam];[Phising]"
 
    '---------------------------------------------------------------------
    ' Werte in ein Feld laden
    '---------------------------------------------------------------------
    arySPAM() = Split(strSPAM, ";")
 
    '---------------------------------------------------------------------
    ' Prüfen, ob im Betreff einer der festgelegten Werte vorkommt
    '---------------------------------------------------------------------
    For lngLoop = 0 To UBound(arySPAM())
 
        If InStr(strSubject, Trim(arySPAM(lngLoop))) Then
            IsSPAM = True
            Exit Function
        End If
 
    Next
 
End Function