birdyb
Goto Top

Per Skript alle Mails älter als 14 Tage von IMAP-Server löschen

Hallo zusammen,

im Moment stehe ich total auf dem Schlauch, denn ich habe die Aufgabe automatisiert alle Mails die älter als 14 Tage sind aus einem IMAP-Postfach löschen zu lassen.
Leider finde ich kein Tool, welches mir bei der Lösung dieses Problems weiterhilft (Vielleicht sind es auch die Tomaten auf meinen Augen face-wink )
Hat jemand von euch eine Idee, wie ich das realisieren kann?

Danke für die Hilfe und beste Grüße!


Berthold

Content-ID: 247933

Url: https://administrator.de/forum/per-skript-alle-mails-aelter-als-14-tage-von-imap-server-loeschen-247933.html

Ausgedruckt am: 06.04.2025 um 22:04 Uhr

Lochkartenstanzer
Lösung Lochkartenstanzer 01.09.2014 aktualisiert um 11:37:53 Uhr
Goto Top
Moin,

IMAPExpire, deletemail & co. helfen Dir nicht?

lks
BirdyB
BirdyB 01.09.2014 um 11:37:48 Uhr
Goto Top
Das waren die Tomaten... Danke!
Lochkartenstanzer
Lochkartenstanzer 01.09.2014 aktualisiert um 11:39:55 Uhr
Goto Top
Zitat von @BirdyB:

Das waren die Tomaten... Danke!

Mach einfach Tomatensalat draus. Mit Zwiebeln, Mozarella und Olivenöl dazu hast Du dann wieder den Durchblick. face-smile

gern geschen.

lks
colinardo
colinardo 01.09.2014 aktualisiert um 11:47:21 Uhr
Goto Top
Hallo Berthold,
und wenn es noch jemand als Outlook Makro braucht, der hier vorbei schaut:
Sub DeleteOldMailsImap()
    Dim fldrImapRoot As Folder, colOldMails As New Collection, mail as Mailitem
    Set fldrImapRoot = Application.Session.Stores("user@domain.de").GetRootFolder  
    parseImapFolders fldrImapRoot, colOldMails
    For Each mail In colOldMails
        mail.Delete
    Next
End Sub

Sub parseImapFolders(ByVal fldr As Folder, ByRef colOldMails As Collection)
    Dim objMail As MailItem, dateRemove As Date
    dateRemove = DateAdd("d", -14, Date)  
    
    If fldr.DefaultItemType = olMailItem Then
        For Each objMail In fldr.items
            If objMail.ReceivedTime < dateRemove Then
                colOldMails.add objMail
            End If
        Next
    End If
    For Each subfolder In fldr.Folders
        parseImapFolders subfolder, colOldMails
    Next
End Sub
Grüße Uwe