OUTLOOK VBA: modTasks

Option Explicit

Private Function GetColonPrefix(ByVal subject As String) As String
    Dim i As Integer
    Dim m As String
    Dim colonPrefix As String
    For i = 1 To Len(subject)
        m = Mid(subject, i, 1)
        If m = " " Then Exit Function
        If m = ":" Then GetColonPrefix = Trim(colonPrefix): Exit Function
        colonPrefix = colonPrefix & m
    Next
End Function
Private Sub GetColonPrefixTest()
    AssertEqual "ccc", GetColonPrefix("test: xyzl skdkdkd"), "testx"
End Sub

Private Function StripPrefix(ByVal subject As String) As String
    Dim prefix As String: prefix = GetColonPrefix(subject)
    subject = Mid(subject, Len(prefix) + 2)
    If Left(subject, 1) = " " Then subject = Mid(subject, 2)
    StripPrefix = Trim(subject)
End Function

Private Sub StripPrefixTest()
    AssertEqual "StripPrefix", StripPrefix("sss: aaa"), "aaa"
    AssertEqual "StripPrefix", StripPrefix("sss:aaa"), "aaa"
    AssertEqual "StripPrefix", StripPrefix("sss zzz:aaa"), "sss zzz:aaa"
End Sub

Private Sub FixxSubjectCategory(ByRef subject As String, ByRef Categories As String)
    If InStr(Categories, ",") > 1 Then Stop: Exit Sub ' Multiple categories is not supported.
    If InStr(Categories, " ") > 1 Then Stop: Exit Sub ' Blank categories is not supported.
    
    Dim colonPrefix As String: colonPrefix = GetColonPrefix(subject)
    If colonPrefix = "http" Or colonPrefix = "RE" Or colonPrefix = "FW" Then
        colonPrefix = ""
    End If
    
    If Len(colonPrefix) > 0 Then
        subject = StripPrefix(subject)
        If Left(colonPrefix, 1) = "@" Or Left(colonPrefix, 1) = "!" Then
            Categories = colonPrefix
        Else
            Categories = "@" & colonPrefix
        End If
    Else
        If Len(Categories) > 0 Then
            If Left(Categories, 1) <> "@" And Left(Categories, 1) <> "!" Then
                Categories = "@" & Categories
            End If
        End If
    End If
End Sub

Private Sub FixxTest()
    Dim subject As String, Categories As String
    
    subject = "aaa: a b c d": Categories = "blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "@aaa"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "@aaa"

    subject = "@aaa: a b c d": Categories = "blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "@aaa"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "@aaa"

    subject = "aaa - a b c d": Categories = "blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "aaa - a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "@blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "aaa - a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "@blah"

    subject = "!aaa: a b c d": Categories = "blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "!aaa"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "!aaa"

    subject = "aaa a b c d": Categories = "!blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "aaa a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "!blah"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "aaa a b c d"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "!blah"

    subject = "http://www.outsystems.com/agile/": Categories = "!Someday"
    FixxSubjectCategory subject, Categories
    AssertEqual "FixxSubjectCategory - Subject", subject, "http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectCategory - Categories", Categories, "!Someday"
End Sub

Private Function GetBracketProject(ByVal subject As String) As String
    Dim project As String
    
    If Len(subject) > 1 Then
        If Left(subject, 1) = "[" Then
            Dim i As Integer: i = InStr(2, subject, "]")
            If i > 1 Then
                project = Mid(subject, 2, i - 2)
            End If
        End If
    End If
    
    GetBracketProject = Trim(project)
End Function
Private Sub GetBracketProjectTest()
    AssertEqual "GetBracketProjectTest", GetBracketProject("[ssss] slslsl"), "ssss"
    AssertEqual "GetBracketProjectTest", GetBracketProject("[ssss ] slslsl"), "ssss"
    AssertEqual "GetBracketProjectTest", GetBracketProject("[  1234f ]slslsl"), "1234f"
End Sub
Private Sub FixxSubjectProject(ByRef subject As String, ByRef project As String)

    Dim projectPrefix As String: projectPrefix = GetBracketProject(subject)
    
    If Len(projectPrefix) > 0 Then
        project = projectPrefix
    Else
        project = ""
    End If
End Sub
Private Sub FixxSubjectProjectTest()
    Dim subject As String: Dim project As String
    
    subject = "http://www.outsystems.com/agile/": project = "Do GDT"
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, ""
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, ""
    
    subject = "[Do GDT] http://www.outsystems.com/agile/": project = "Do GDT"
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "[Do GDT] http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, "Do GDT"
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "[Do GDT] http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, "Do GDT"
    
    subject = "[Do GDT] http://www.outsystems.com/agile/": project = "aaaaaa"
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "[Do GDT] http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, "Do GDT"
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "[Do GDT] http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, "Do GDT"
    
    subject = "http://www.outsystems.com/agile/": project = ""
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, ""
    FixxSubjectProject subject, project
    AssertEqual "FixxSubjectProject - Subject", subject, "http://www.outsystems.com/agile/"
    AssertEqual "FixxSubjectProject - Project", project, ""
End Sub


Public Sub FixTasks()
    Dim subject As String
    Dim colonPrefix As String
    Dim Categories As String
    Dim Companies As String
    Dim c1 As New Collection
    Dim c2 As New Collection
    
    Dim taskFolder As Outlook.MAPIFolder: Set taskFolder = Session.GetDefaultFolder(olFolderTasks)
    
    Dim t As Outlook.TaskItem
    For Each t In taskFolder.Items
        If Not t.Complete Then
            Categories = t.Categories
            Companies = t.Companies
            
            subject = t.subject
            colonPrefix = GetColonPrefix(subject)
            
            Dim xSubject As String: xSubject = subject
            Dim xCategories As String: xCategories = Categories
            FixxSubjectCategory subject, Categories
            If subject <> xSubject Or Categories <> xCategories Then
                t.subject = subject
                t.Categories = Categories
                t.Save
            End If

            xSubject = subject
            Dim xProject As String: xProject = Companies
            FixxSubjectProject subject, Companies
            If subject <> xSubject Or Companies <> xProject Then
                t.subject = subject
                t.Companies = Companies
                t.Save
            End If
            
            If Len(Categories) > 1 Then
                On Error Resume Next
                c1.Add Categories, Categories
                On Error GoTo 0
            End If
    
            If Len(Companies) > 1 Then
                On Error Resume Next
                c2.Add Companies, Companies
                On Error GoTo 0
            End If
    
        End If
    Next

    Dim names As String: Dim v As Variant
    For Each v In c1
        names = names & vbCrLf & vbTab & v
    Next
    names = names & vbCrLf & "----" & vbCrLf
    For Each v In c2
        names = names & vbCrLf & vbTab & v
    Next
    If Len(names) > 0 Then MsgBox names
End Sub

'Private Sub test()
' RenamePrefix "NA", "oldNA"
' RenamePrefix "Kenny", "oldKenny"
' RenamePrefix "Link", "Read"
' RenamePrefix "Learning", "Read"
'End Sub

Private Sub RenamePrefix(ByVal oldCat As String, ByVal newcat As String)
    Dim subject As String
    Dim colonPrefix As String
    Dim Categories As String
    Dim c As New Collection
    
    Dim taskFolder As Outlook.MAPIFolder: Set taskFolder = Session.GetDefaultFolder(olFolderTasks)
    
    Dim t As Outlook.TaskItem
    For Each t In taskFolder.Items
        If Not t.Complete Then
            Categories = t.Categories
            
            subject = t.subject
            colonPrefix = GetColonPrefix(subject)
            
            If LCase(oldCat) = LCase(colonPrefix) Then
                subject = newcat & ": " & StripPrefix(subject)
            End If
            
            Dim xSubject As String: xSubject = subject
            Dim xCategories As String: xCategories = Categories
            FixxSubjectCategory subject, Categories
            
            If subject <> xSubject Or Categories <> xCategories Then
                t.subject = subject
                t.Categories = Categories
                t.Save
            End If
            
            If Len(Categories) > 1 Then
                On Error Resume Next
                c.Add Categories, Categories
                On Error GoTo 0
            End If
    
        End If
    Next

    Dim names As String
    Dim v As Variant: For Each v In c
        names = names & vbCrLf & vbTab & v
    Next
    If Len(names) > 0 Then MsgBox names
End Sub