Page History

Public Sub double_mail_items()
    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items
    Dim objFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim pDate, pSubject As String
    Dim pSize As Double
    
    pDate = ""
    pSize = 0
    pSubject = ""
    
    Set objOL = Outlook.Application
    Set objFolder = objOL.ActiveExplorer.CurrentFolder
    Set objItems = objFolder.Items
    objItems.Sort "[CreationTime]", False
    
    For Each obj In objItems
        'Debug.Print obj.MessageClass & "|" & obj.Subject
        'IPM.Note ==> normale unverschl¸sselte Mail
        'IPM.Note.MRS.FAX ==> elektronisches Fax
        'IPM.Post ==> Notizzettel
        'IPM.Schedule.Meeting.Request ==> Besprechungsanfrage
        'IPM.Schedule.Meeting.Resp.Neg ==> Besprechungsanfrage Abgelehnt
        'REPORT.IPM.Note.IPNNRN ==> Nicht gelesen
        'IPM.Note.Rules.OofTemplate.Microsoft ==> Abwesenheitsnotiz
        'REPORT.IPM.Note.NDR ==> Unzustellbar
        'Weitere Nachrichtenklassen mˆglich ...
        
        With obj
            If (.MessageClass = "IPM.Schedule.Meeting.Resp.Neg") Or (.MessageClass = "IPM.Note.Rules.OofTemplate.Microsoft") Or (.MessageClass = "REPORT.IPM.Note.NDR") Then
                .Categories = "remove"
                .Save
            End If
            If (.MessageClass = "IPM.Note") Or (.MessageClass = "IPM.Post") Or (.MessageClass = "IPM.Note.MRS.FAX") Then
                'Mit Ber¸cksichtigung pSize funktioniert es nur 1x, weil durch das setzen der Kategorie die Grˆ?e der Nachricht ge‰ndert wird.
                If (pDate = .CreationTime) And (pSize = .Size) And (pSubject = .Subject) Then
                    Debug.Print pDate & "|" & pSubject & "|" & pSize
                    pSize = obj.Size
                    .Categories = "double"
                    .Save
                Else
                    pSize = obj.Size
                End If
                pSubject = obj.Subject
                pDate = obj.CreationTime
            Else
                pSize = 0
                pSubject = ""
                pSubject = ""
            End If
        End With

   
    Next
 
    Set obj = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
End Sub