Mails in (Unter-)Ordnern löschen, die älter als x Tage sind

Dieses Thema im Forum "MS Outlook" wurde erstellt von CaptainScott, 22 Oktober 2012.

  1. CaptainScott

    CaptainScott
    Expand Collapse
    New Member

    Registriert seit:
    24 Februar 2011
    Beiträge:
    60
    Zustimmungen:
    0
    Hallo zusammen,

    auf der Arbeit nutze ich Outlook 2007 mit einem Exchange-Postfach. Admin-Technisch sind leider die Funktionen zur Auto-Archivierung deaktiviert, so dass ich Mails die älter als 14 Tage nicht mit OnBoardmitteln automatisch löschen kann. Also muss ein gutes altes Makro her.

    Es geht darum, Mails in bestimmten Ordnern die älter als 14 Tage sind zu löschen. Die dienen mir nur als Gedankenstütze und können nach spätestens 14 Tage zum Kollegen (Müll)Tonne :)

    Folgendes Makro habe ich mir ergoogelt (viele löschen damit ihren Junk Ordner) und abgeändert, leider bekomme ich es nicht hin, es auf mein Postfach umzumünzen. Daher bitte ich euch um Hilfe. Wie spreche ich nur bestimmte Ordner mit dem Makro an. So sieht es bisher aus:

    Code:
    Public Sub Application_Startup()
        Set Items = Application.GetNamespace("MAPI").Folders.Item("Postfach - Mustermann, Max").Folders("Vertretung").Items
            For i = 1 To Items.Count()
                If Items(i).ReceivedTime() < (Now() - 14) Then
                Items(i).Delete
                End If
            Next
        End Sub
    Ich habe schon verschiedene Abwandlungen für die Set Items-Zeile durch, denn die ist scheinbar das Problem. Mein Exchange-Postfach sieht im Stammbaum folgendermaßen aus:
    Code:
    Postfach - Mustermann, Max
    [INDENT]Entwürfe
    Gelöschte Objekte
    Gesendete Objekte
    Pausausgang
    Posteingang
    [INDENT]Wichtiges
    Unwichtiges
    MHM
    Rechnungserstellung
    [INDENT]Eigene
    Vertretung
    [/INDENT][/INDENT][/INDENT]
    
    Die Ordner, die bereinigt werden sollen, sind die Ordner "Eigene" und "Vertretung". Vornehmlich aber der Ordner Vertretung (im Stammbaum also "Postfach - Mustermann, Max" ==> "Posteingang" ==> "Rechnungserstellung" ==> "Vertretung").

    Wie muss das Makro verändert werden, damit es im Ordner "Vertretung" alle Mails prüft ob diese älter als 14 Tage sind und wenn ja, löscht?

    Gruß Maik
     
  2. CaptainScott

    CaptainScott
    Expand Collapse
    New Member

    Registriert seit:
    24 Februar 2011
    Beiträge:
    60
    Zustimmungen:
    0
    Hi,

    für diejenigen die es interessiert, ich habe es jetzt endlich geschafft:

    Code:
    Public Sub Application_Startup()
    
        Dim Ordner As MAPIFolder
        Dim Objekt As Object
    
        On Error Resume Next
        Set Ordner = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Rechnungserstellung").Folders("Vertretung")
            For Each Objekt In Ordner.Items
                With Objekt
                    If .ReceivedTime() < (Now() - 14) Then
                        .Delete
                    End If
                End With
            Next Objekt
        End Sub
    
    Sollte ein Ordner genutzt werden der noch tiefer in einem Ordnerbaum steckt, hängt ihr einfach ein .Folders("Ordnername") an die Zeile mit dem Application.GetNamespace("MAPI")........

    Wenn ihr noch etwas mehr Sicherheit reinbringen möchtet, könnt ihr auch folgende Zeile benutzen:
    Code:
    If .ReceivedTime() < (Now() - 14) And .UnRead = False Then
    So werden die Mails geprüft ob sie gelesen wurden und nicht aus versehen beim Öffnen von Outlook gelöscht, falls ihr 2-3 Wochen im Urlaub wart und die Mails noch garnicht lesen konntet.

    Gruß Maik
     
    #2 CaptainScott, 24 Januar 2013
    Zuletzt bearbeitet: 25 Januar 2013
  3. CaptainScott

    CaptainScott
    Expand Collapse
    New Member

    Registriert seit:
    24 Februar 2011
    Beiträge:
    60
    Zustimmungen:
    0
    Und nochmal ich...

    zum obigen Code fiel mir auf, dass der Start von Outlook sehr lange dauert, bis wirklich alle Mails auf die genutzen Kriterien überprüft wurden. Das liegt aus meiner Sicht an dem Codeteil
    Code:
    For Each Objekt In Ordner.Items
    .

    Hat jemand eine Idee wie man das eingrenzen könnte auf z.B. die ersten 50 Mails (Elemente) im zu prüfenden Ordner? Das würde die Laufzeit, bzw. den Start von Outlook bestimmt beschleungen.

    Gruß Maik
     
  4. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Morgen Maik,

    Code:
    iMax = IIf(Ordner.Items.Count >= 50, 50, Ordner.Items.Count)
    For i = 1 To iMax
       With Ordner.Items(i)
    cu, Bernd
     
  5. Danjelusbonus

    Danjelusbonus
    Expand Collapse
    New Member

    Registriert seit:
    16 Januar 2015
    Beiträge:
    2
    Zustimmungen:
    0
    Erstmal Danke für das Makro sowas in der Art habe ich gesucht.

    Habe nur eine Frage und zwar kann ich das auch auf den Ordner "Gelöschte Objekte" übernehmen, dass alle E-Mails älter wie 14 Tage komplett entfernt werden?

    Outlook 2007

    Code:
    .Folders("Gelöschte Objekte")
    
    bringt eine Fehlermeldung

    Code:
    Laufzeitfehler
    Array-Index außerhalb des zulässigen Bereichs
    
    Bei Funktioniert aber nur das Script

    Code:
    Public Sub Application_Startup()
    Set Items = Application.GetNamespace("MAPI").Folders.Item("Postfach - Mustermann, Max").Folders("Gelöschte Objekte").Items
    For i = 1 To Items.Count()
    If Items(i).ReceivedTime() < (Now() - 14) Then
    Items(i).Delete
    End If
    Next
    End Sub
    
     
  6. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Morgen,

    nimm im Outlook mal so etwas her:

    Code:
    Sub CheckPickFolder()
      Dim objFolder As Object
      
      Set objFolder = Application.GetNamespace("MAPI").PickFolder
      If Not objFolder Is Nothing Then Debug.Print objFolder.FullFolderPath
    End Sub
    Das starte und wähle dann den Ordner manuell aus. Dessen Pfad wird in das VBA-Direktfenster geschrieben.

    Hier ergibt das:

    \\Persönliche Ordner\Gelöschte Objekte

    Damit braucht Du so einen Code um an den Ordner zu kommen:

    Code:
    Sub x()
      Dim objFolder As Object
      
      Set objFolder = Application.GetNamespace("MAPI").Folders("Persönliche Ordner").Folders("Gelöschte Objekte")
      Debug.Print objFolder.FullFolderPath
    End Sub
    HTH, Bernd
     
  7. Danjelusbonus

    Danjelusbonus
    Expand Collapse
    New Member

    Registriert seit:
    16 Januar 2015
    Beiträge:
    2
    Zustimmungen:
    0
    Danke für deine Hilfe. Leider klappt das auch nicht. Wenn ich Outlook startet passiert garnichts. Wenn ich das Makro manuell starte kommt die Ordner abfrag mehr aber auch nicht.

    Kann es daran liegen, weil meine E-Mail Adresse über ein Exchange Server verbindet?
     
  8. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hallo,

    die obige Routine tut nichts anderes als Dir die richtige Syntax für den gewünschten Ordner zu zeigen. Mehr nicht.

    Wenn Du die hast kannst Du das in Deine Sub einbauen.

    Das Ergebnis wird in das VBA-Direktfenster geschrieben. Öffne das mal und starte dann das Makro manuell.

    cu, Bernd
     
  9. Hab da mal ne Frage

    Hab da mal ne Frage
    Expand Collapse
    New Member

    Registriert seit:
    12 April 2015
    Beiträge:
    2
    Zustimmungen:
    0
    könntet ihr den Text des Makros nochmal hierher kopieren?
    Ich kenne mich leider nicht so gut aus, weiß aber immerhin, wo ich das hinkopieren muss...
    könnt ihr bitte auch nochmal kommentieren, wie man seine Änderungen vornehmen muss, damit man das Makro benutzen kann....
     
  10. Hab da mal ne Frage

    Hab da mal ne Frage
    Expand Collapse
    New Member

    Registriert seit:
    12 April 2015
    Beiträge:
    2
    Zustimmungen:
    0
    ok, bin jetzt weitergekommen.....
    muss nur noch meinen Ordner irgendwie da reinschreiben.....

    Public Sub Application_Startup()
    Set myOlExp = myOlApp.ActiveExplorer
    Dim Ordner As MAPIFolder
    Dim Objekt As Object

    On Error Resume Next
    Set Ordner = Application.GetNamespace("MAPI).GetDefaultFolder(olFolderInbox).Folders("X@Y.com").Folders("Posteingang")

    For Each Objekt In Ordner.Items
    With Objekt
    If .ReceivedTime() < (Now() - 400) Then
    .Delete​
    End If​
    End With​
    Next Objekt
    End Sub

    email.jpg
    Eigentlich möchte ich das Makro für den Ordner "Posteingang" unter "X@Y.com"
    Ist das möglich?
    Könnte mir da jemand helfen?

    Er sagt mir im Moment " Erwartet: Listentrennzeichen oder)" und markiert das X@
    jemand eine Idee?
     
  11. RO_SCH

    RO_SCH
    Expand Collapse
    Moderator

    Registriert seit:
    27 August 2006
    Beiträge:
    2.438
    Zustimmungen:
    14
Die Seite wird geladen...

Diese Seite empfehlen