Damian Brunold

Mailduplikate in Outlook erkennen

2014-04-14 10:42 Programmieren, Windows

Ich habe die letzten Tage (oder eher Nächte) damit verbracht, den neuen Notebook von Rahel zu konfigurieren. Sie brauchte eine neue Maschine, weil die alte langsam altersschwach wurde und die Festplatte prallvoll war. Weiter wurde das Windows-XP-Problem höchst dringlich. So kamen wir zum Schluss, einen neuen Notebook anzuschaffen, state of the art, mit allem was es heute so gibt und mit Windows 8.1 und Office 2013.

Die Maschine ist gut, bis auf den Bildschirm, der als entspiegelt angepriesen war, aber so was von spiegelt! Windows 8.1 ist gewöhnungsbedürftig aber kann durchaus brauchbar eingerichtet werden.

Beim Transferieren und Umstellen der Mails kam es aus bestimmten Gründen zu einem erneuten Download von einigen Tausend Mails. Die Aufgabe war nun, diese doppelten Mails zu erkennen und zu löschen.

Ich hatte schon seit mehr als einer Dekade nichts mit VBA gemacht, aber die Doku dazu ist durchaus gut. Ich musste einiges experimentieren, und konnte am Schluss eine pragmatische, funktionierende Lösung finden:

Sub mail_duplikate_eliminieren()

    Dim ns As Outlook.NameSpace
    Dim folder As Outlook.folder
    Dim items As Outlook.items
    Dim item As Object
    Dim dest As Outlook.folder
    Dim buf(1 To 300) As MailItem
    Dim first As Integer
    Dim last As Integer
    Dim cur As Integer
    Dim moved As String

    Set ns = Session.Application.GetNamespace("MAPI")
    Set folder = ns.GetDefaultFolder(olFolderInbox)
    Set dest = folder.Folders("Duplikate")
    Set items = folder.items

    items.Sort "SentOn"
 
    first = 1
    last = 300
    cur = 1

    For Each item In items
        DoEvents
        If TypeOf item Is MailItem Then
            moved = "no"
            For i = first To last
                Dim other As MailItem
                Set other = buf(i)
                If TypeName(other) <> "Nothing" Then
                    If (item.SenderEmailAddress = other.SenderEmailAddress)
And (item.Subject = other.Subject) And (item.SentOn = other.SentOn) And
(item.Body = other.Body) Then
                        item.Move dest
                        moved = "yes"
                        Exit For
                    End If
                End If
            Next i

            If moved = "no" Then
                Set buf(cur) = item
                cur = cur + 1
                If cur > last Then
                    cur = first
                End If
            End If
        End If
    Next
End Sub

Ich bitte darüber hinwegzusehen, dass ich Booleans mit Strings emuliere. Es funktioniert, auch wenn es unschön ist und in drei Sekunden geändert werden könnte.

Mehr Probleme hatte ich damit, dass die Ordnung der Mails nicht zuverlässig war. Am Bildschirm wurden die Duplikate zwar direkt bei den Originalen angezeigt, aber eine naive Prozedur, die das aktuelle MailItem mit dem eins davor vergleicht, fand nur einen kleinen Teil der Duplikate.

Darum speichere ich jetzt die letzten 300 Mails und vergleiche damit. So ist die Chance, dass das Duplikat resp. Original dabei ist, sehr gross.

Im konkreten Fall lief die Prozedur eine lange Zeit und fand dabei alle Duplikate. Operation erfolgreich.