Remove all duplicate bug entries from email list

cleanupbugs.vba

Option Explicit
Private Enum deleteReason
 DoNotDelete = 0
 userComment = 1
 DuplicateComment = 2
End Enum
Private Function WordBefore(ByVal str As String, pos As Long) As String
    Dim startPos As Long
    startPos = pos - 1
    
    str = UCase(str)
    Do While startPos <> 0
        If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123459789_", Mid(str, startPos, 1)) = 0 Then
            Exit Do
        Else
            startPos = startPos - 1
        End If
    Loop
    
    startPos = startPos + 1
    WordBefore = Mid(str, startPos, (pos - startPos))
End Function
Private Function WordAfter(ByVal str As String, pos As Long, Optional ByVal wordChars As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_") As String
    Dim endPos As Long
    endPos = pos + 1
    Dim strLen As Long
    strLen = Len(str)
    
    str = UCase(str)
    Do While endPos < strLen
        If InStr(wordChars, Mid(str, endPos, 1)) = 0 Then
            Exit Do
        Else
            endPos = endPos + 1
        End If
    Loop
    
    If endPos > strLen Then
        WordAfter = ""
    Else
        If endPos = strLen Then
            endPos = endPos + 1
        End If
        WordAfter = Mid(str, pos + 1, endPos - (pos + 1))
    End If
End Function
Private Function GetBugNumber(ByVal subject As String) As String
    Dim bugId As String
    Dim firstDash As Long
    Dim secondDash As Long
    Dim product As String
    Dim project As String
    Dim bugNumber As String
    
    bugId = ""
    firstDash = 0
    secondDash = InStr(subject, "-")
    
    Do While bugId = ""
        firstDash = secondDash
        secondDash = InStr(firstDash + 1, subject, "-")
        If firstDash <> 0 And secondDash <> 0 Then
            product = WordBefore(subject, firstDash)
            project = WordAfter(subject, firstDash)
            If WordBefore(subject, secondDash) = project Then
                bugNumber = WordAfter(subject, secondDash, "0123456789")
                If bugNumber <> "" Then
                    bugId = product + "-" + project + "-" + bugNumber
                End If
            End If
        Else
            bugId = ""
            Exit Do
        End If
    Loop
    Debug.Print bugId + " -> '" + subject + "'"
    
    GetBugNumber = bugId
End Function

Private Function GetUserName(ByRef currentUser As Recipient) As String
    Dim sepPos As Integer
    
    sepPos = InStr(currentUser.name, ", ")
    If sepPos <> 0 Then
        GetUserName = Mid(currentUser.name, sepPos + 2) + " " + Left(currentUser.name, sepPos - 1)
    Else
        GetUserName = currentUser.name
    End If
End Function
Private Function CanDelete(ByRef mail As MailItem, ByRef bugs, ByRef userCommentIntro As String) As deleteReason
    Dim bugNumber As String
    
    CanDelete = DoNotDelete
    
    If InStr(mail.Body, userCommentIntro) <> 0 Then
        CanDelete = userComment
    ElseIf InStr(mail.Body, "Your submission") <> 0 Or InStr(mail.subject, "(Sytse Reitsma)") <> 0 Or InStr(mail.Body, "An action was done by Sytse Reitsma") <> 0 Then
        CanDelete = userComment
    Else
        bugNumber = GetBugNumber(mail.subject)
        If bugNumber <> "" Then
            If bugs.Contains(bugNumber) Then
                CanDelete = DuplicateComment
            Else
                bugs.Add (bugNumber)
            End If
        End If
    End If
End Function
Private Sub RemoveDuplicatesFolder(ByVal folderName As String, noDelete As Boolean)
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim deletedCount As Integer
    Dim totalCount As Integer
    Dim userCommentIntro As String
    Dim bugs
    Dim i As Integer
    Dim canDeleteReason As deleteReason
    
    
    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = objFolder.Folders(folderName)
    userCommentIntro = "An action was done by " + GetUserName(objNS.currentUser)

    Set bugs = CreateObject("System.Collections.ArrayList")
    
    deletedCount = 0
    totalCount = objFolder.Items.Count
    For i = objFolder.Items.Count To 1 Step -1
        If TypeName(objFolder.Items(i)) = "MailItem" Then
            canDeleteReason = CanDelete(objFolder.Items(i), bugs, userCommentIntro)
            If canDeleteReason <> DoNotDelete Then
                If canDeleteReason = userComment Then Debug.Print "Deleting own comment'" + objFolder.Items(i).subject + "'"
                If canDeleteReason = DuplicateComment Then Debug.Print "Deleting duplicate'" + objFolder.Items(i).subject + "'"
                If Not noDelete Then objFolder.Items(i).Delete
                deletedCount = deletedCount + 1
            End If
        End If
    Next
    
    MsgBox folderName + ": Deleted " + CStr(deletedCount) + " of " + CStr(totalCount) + " messages."
End Sub

Sub RemoveDuplicates()
    RemoveDuplicatesFolder "Bugs", False
    RemoveDuplicatesFolder "Azure", False
End Sub

Private Sub FooTheBar()
Debug.Print GetBugNumber("[EXTERNAL] [Build succeeded] MoogNV-Jenkins-SimAndTest - SimAndTest:features/TestController/hpu_improvements - MoogNV - 62cd76bd")
End Sub

Added filter for user coments

Option Explicit
Private Enum deleteReason
 DoNotDelete = 0
 DuplicateComment = 2
End Enum
Private Function GetPRNumber(ByVal subject As String) As String
    Dim prStartIndex As Long
    Dim prEndIndex As Long
    
    Const prHeader As String = "Pull request #"

    'THK/SocketBoard - Pull request #358: AHWP-2173: Use hardware PWM for CP signal
    prStartIndex = InStr(subject, prHeader)
    GetPRNumber = ""
    If prStartIndex <> 0 Then
        prStartIndex = prStartIndex + Len(prHeader)
        prEndIndex = InStr(prStartIndex + 1, subject, ":")
        If prEndIndex <> 0 Then
            GetPRNumber = Mid(subject, prStartIndex, prEndIndex)
        End If
    End If
    Debug.Print GetPRNumber; " <= " + subject
End Function
Private Function GetJiraTicket(ByVal subject As String) As String
    Dim startIndex As Long
    Dim endIndex As Long
    
    Const header As String = "[JIRA] ("

    '[JIRA] (AHWP-2540) Create an "es" console command for Eventbus Stats
    startIndex = InStr(subject, header)
    GetJiraTicket = ""
    If startIndex <> 0 Then
        startIndex = startIndex + Len(header)
        endIndex = InStr(startIndex + 1, subject, ")")
        If endIndex <> 0 Then
            GetJiraTicket = Mid(subject, startIndex, endIndex)
        End If
    End If
    Debug.Print GetJiraTicket; " <= " + subject
End Function

Private Function GetUserName(ByRef currentUser As Recipient) As String
    Dim sepPos As Integer
    
    sepPos = InStr(currentUser.Name, ", ")
    If sepPos <> 0 Then
        GetUserName = Mid(currentUser.Name, sepPos + 2) + " " + Left(currentUser.Name, sepPos - 1)
    Else
        GetUserName = currentUser.Name
    End If
End Function
Private Function CanDelete(ByRef mail As MailItem, ByRef prIds) As deleteReason
    Dim prNumber As String
    Dim jiraTicket As String
    
    CanDelete = DoNotDelete
    
    prNumber = GetPRNumber(mail.subject)
    If prNumber <> "" Then
        If prIds.Contains(prNumber) Then
            CanDelete = DuplicateComment
        Else
            prIds.Add (prNumber)
        End If
    Else
        jiraTicket = GetJiraTicket(mail.subject)
        If jiraTicket <> "" Then
            If prIds.Contains(jiraTicket) Then
                CanDelete = DuplicateComment
            Else
                prIds.Add (jiraTicket)
            End If
        End If
    End If
End Function
Private Sub RemoveDuplicateTicketMailsFromFolder(ByVal folderName As String, noDelete As Boolean)
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim deletedCount As Integer
    Dim totalCount As Integer
    Dim prIds
    Dim i As Integer
    Dim canDeleteReason As deleteReason
    
    
    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = objFolder.Folders(folderName)

    Set prIds = CreateObject("System.Collections.ArrayList")
    
    deletedCount = 0
    totalCount = objFolder.Items.Count
    For i = objFolder.Items.Count To 1 Step -1
        If TypeName(objFolder.Items(i)) = "MailItem" Then
            canDeleteReason = CanDelete(objFolder.Items(i), prIds)
            If canDeleteReason <> DoNotDelete Then
                If canDeleteReason = DuplicateComment Then Debug.Print "Deleting duplicate'" + objFolder.Items(i).subject + "'"
                If Not noDelete Then objFolder.Items(i).Delete
                deletedCount = deletedCount + 1
            End If
        End If
    Next
    
    MsgBox folderName + ": Deleted " + CStr(deletedCount) + " of " + CStr(totalCount) + " messages."
End Sub
Private Sub RemoveDuplicateConfluenceMails(noDelete As Boolean)
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim deletedCount As Integer
    Dim totalCount As Integer
    Dim subjects
    Dim i As Integer
    Dim canDeleteReason As deleteReason
    
    
    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = objFolder.Folders("Confluence")

    Set subjects = CreateObject("System.Collections.ArrayList")
    
    deletedCount = 0
    totalCount = objFolder.Items.Count
    For i = objFolder.Items.Count To 1 Step -1
        If TypeName(objFolder.Items(i)) = "MailItem" Then
            If subjects.Contains(objFolder.Items(i).subject) Then
                If Not noDelete Then objFolder.Items(i).Delete
                deletedCount = deletedCount + 1
            Else
                subjects.Add (objFolder.Items(i).subject)
            End If
        End If
    Next
    
    MsgBox "Confluence: Deleted " + CStr(deletedCount) + " of " + CStr(totalCount) + " messages."
End Sub
Sub RemoveDuplicates()
    RemoveDuplicateTicketMailsFromFolder "Git", False
    RemoveDuplicateTicketMailsFromFolder "JIRA", False
    RemoveDuplicateConfluenceMails False
End Sub