Random observations of a very experienced software artist.

    Duplicate EMail Elimination

    John McCann  May 17 2012 10:56:57 AM
    Argh, ran into a problem with my inbox filled with duplicates while I was having problems with an IMAP source.   I wrote a duplicate email eliminator that I thought others might be able to use to save themselves some time.

    ' Agent Duplicate Deleter
    ' Purpose:  Delete duplicates emails from selected list

    ' Change History:
    ' May 17, 2012 - John McCann
    ' - Initial Creation

    Option Public
    Option Declare


    ' Class Msg
    ' Description: Information to compare and find the email
    Class Msg
            Public strUNID As String
            Public strMsgID As String
            Public strOther        As String
            Public strSubject As String
           

    End Class
    Sub Initialize
           
            Dim session                 As New NotesSession
            Dim dbThis                        As NotesDatabase
            Dim dcThis                        As NotesDocumentCollection
            Dim docThis                        As NotesDocument
            Dim itmMessageID        As NotesItem
            Dim itmOther                As NotesItem
            Dim strUNID                        As String
           
            Dim fRemoved                As Boolean
            Dim lstMsgs                        List As Msg
            Dim lstIDs                        List As String
            Dim vntIDs                        As Variant
            Dim msgThis                        As Msg
            Dim msgBase                        As Msg
            Dim i                                As Long
           
            On Error GoTo This_Error
           
            Set dbThis = session.Currentdatabase
            Set dcThis = dbThis.Unprocesseddocuments
            Set docThis = dcThis.Getfirstdocument()
            While Not docThis Is Nothing
                    strUNID = docThis.UniversalID
                   
                    ' going to match on one of the message IDs
                    Set itmMessageID = docThis.GetFirstItem("$MessageID")
                    If itmMessageID Is Nothing Then
                            Set itmMessageID = docThis.GetFirstItem("$IMAPUID")
                    End If
                   
                    ' Need at least another field for uniqueness
                    Set itmOther = docThis.GetFirstItem("$INetOrig")
                    If itmOther Is Nothing Then
                            Set itmOther = docThis.Getfirstitem("$Orig")
                            If itmOther Is Nothing Then
                                    Set itmOther = docThis.Getfirstitem("$Abstract")
                                    If itmOther Is Nothing Then
                                            Set itmOther = docThis.GetFirstitem("DomainKey_Signature")
                                    End If
                            End If
                    End If
                    ' create the message for our list
                    Set msgThis = New Msg
                    With msgThis
                            .strMsgID = itmMessageID.Text
                            .strSubject = docThis.Subject(0)
                            .strOther = itmOther.Text
                            .strUNID = strUNID
                    End With
                   
                    ' save the message
                    Set lstMsgs(strUNID) = msgThis
                   
                    ' create a list by IDs for dup elimination
                    If IsElement(lstIDs(msgThis.strMsgID)) THen
                            lstIDS(msgThis.strMsgID) = lstIDS(msgThis.strMsgID) & ";" & docThis.UniversalID
                    Else
                            lstIDS(msgThis.strMsgID) = docThis.UniversalID
                    End if
                    Set docThis = dcThis.Getnextdocument(docThis)
            Wend
           
            ' now, figure out which ones to remove
            ForAll msgID In lstIDs
                    vntIDs = Split(msgID,";")
                    ' only if more than 1
                    If UBound(vntIDs) > 0 Then
                            Set msgBase = lstMsgs(vntIDs(0))
                            ' compare each to the first
                             For i = 1 To UBound(vntIDs)
                                     strUNID = vntIDs(i)
                                     If strUNID <> "" Then
                                             Set msgThis = lstMsgs(strUNID)
                                             ' if all three items match, then remove
                                             If msgThis.strSubject = msgBase.strSubject Then
                                                     If msgThis.strOther = msgBase.strOther Then
                                                             If msgThis.strMsgID = msgBase.strMsgID Then
                                                                     Set docThis = dbThis.Getdocumentbyunid(strUNID)
                                                                     Call docThis.Remove(True)
                                                                     Erase lstMsgs(strUNID)
                                                             End If
                                                     End If
                                             End If
                                     End If
                             Next
                    End If
            End ForAll
                   

           
    This_Exit:
            Exit Sub
    This_Error:
            MsgBox "Error " & Error & ", Subject=" & docThis.Subject(0) & ", Time=" & CStr(docThis.Created)
            Resume this_Exit
           
    End Sub
    Comments
    No Comments Found