Creating JIRA task from Email in MS Outlook

Question

Every day I get 5 to 30 Appointment emails with almost the same content from which I need to create the Tasks in Atlassian Jira. I wrote a macro to automate this process. I've never written anything in VBA before and would be grateful for correcting my code. This macro works.

There is a function Base64Encode that I copied from this documentation

I searched for a way to create a JSON object from the Appointment email, in the end, I decided to create it myself, looks scary but works.

Public Sub AcceptMeeting(ActiveFolder, Inbox As String)
    'Parameter: Postfach / Ordner im Postfach

    Dim myNamespace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder

    Dim Subfolder As Outlook.Folder
    Dim Folder As Outlook.Folder
    Dim Change As Outlook.Folder

    Dim Item As Object
    Dim myAppt As Outlook.AppointmentItem
    Dim myMtg As Outlook.MeetingItem
    
    'Counter to return how many Events was accepted
    Dim counter As Integer
    counter = 0

    Dim Forward As Outlook.MeetingItem
    Dim Accept As Boolean

    Set myNamespace = Application.GetNamespace("MAPI")

    Set myFolder = myNamespace.Folders(ActiveFolder)
    Set Folders = myFolder.Folders

    Set Subfolder = Folders.Item(Inbox)

    For Each Item In Subfolder.Items
        DoEvents
        
        Accept = False
    
        If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then

            If ActiveFolder = "Application Management Linux1, I351" Then
                Accept = True
            End If
            
            'Label for JIRA task
            Dim jiraLabel As String
            
            If InStr(1, LCase(Item.Subject), "change") > 0 And Item.UnRead = True And Accept = True Then
                If InStr(1, LCase(Item.Subject), "produktion") > 0 Then
                    Item.Categories = "Change Produktion" 'Kategorie setzen PROD
                    jiraLabel = """Produktion"""
                ElseIf InStr(1, LCase(Item.Subject), "integration") > 0 Then
                    Item.Categories = "Change Integration" 'Kategorie setzen INT
                    jiraLabel = """Integration"""
                ElseIf InStr(1, LCase(Item.Subject), "test") > 0 Then
                    Item.Categories = "Change Integration" 'Kategorie setzen INT
                    jiraLabel = """Testing"""
                Else
                    Item.Categories = "Change Info" 'Kategorie setzen Info
                    jiraLabel = """Info"""
                End If
            
                'Accept Appointment
                Set myAppt = Item.GetAssociatedAppointment(True)
                Set myMtg = myAppt.Respond(olResponseAccepted, True)
                
                Item.UnRead = False
            
                If ActiveFolder = "Application Management Linux1, I351" Then
                    
                    'Parse Email to JSON and send
                    Dim Msg As Outlook.MeetingItem
                    Set Msg = Item
                    Set recips = Msg.Recipients
                    Dim recip As Outlook.Recipient
                    
                    Dim customBody As String
                    customBody = Replace(Msg.Body, """", "'")
                    customBody = Replace(customBody, vbCr & vbLf, "\n")
                    customBody = Replace(customBody, vbCr, "\n")
                    customBody = Replace(customBody, vbLf, "\n")
                    Dim customSubject As String
                    customSubject = Replace(Msg.Subject, """", "'")
                    customSubject = Replace(customSubject, vbCr & vbLf, "\n")
                    customSubject = Replace(customSubject, vbCr, "\n")
                    customSubject = Replace(customSubject, vbLf, "\n")
                    
                                        
                    Dim regEx As New RegExp
                    regEx.Pattern = "^\w+\s\w+,\sI351$"
                    
                    For Each recip In recips
                        If regEx.Test(recip.AddressEntry) And recip.AddressEntry <> "Application Management Linux1, I351" Then
                       
                            
                            'Values to create JSON
                            Dim flds, prt, id, asgn, smry, descrp, issu, name, lfbrkt, rtbrkt, cma, _
                                dbdots, JSON, issuName, label, startAt, endDate, sqLfBrkt, sqRtBrkt As String
                            flds = """fields"""
                            prt = """project"""
                            id = """id"""
                            asgn = """assignee"""
                            smry = """summary"""
                            descrp = """description"""
                            issu = """issuetype"""
                            label = """labels"""
                            issuName = """Test"""
                            startAt = """customfield_10021"""
                            endDate = """customfield_12760"""
                            name = """name"""
                            lfbrkt = "{"
                            rtbrkt = "}"
                            cma = ","
                            dbdots = ":"
                            sqLfBrkt = "["
                            sqRtBrkt = "]"
                            
                            'Custom Date Formatting
                            Dim appStartDate, appStartTime, appEndDate, appEndTime As Date
                            appStartDate = myAppt.Start
                            appStartTime = myAppt.Start
                            appEndDate = myAppt.End
                            appEndTime = myAppt.End

                            'JIRA Rest requears specific format, so we have to format out date and time
                            Dim startDateString, endDateString As String
                            startDateString = Format(appStartDate, "yyyy-mm-yy") + "T" + Format(appStartTime, "hh:mm") + ":00.000+0200"
                            endDateString = Format(appEndDate, "yyyy-mm-dd") + "T" + Format(appEndTime, "hh:mm") + ":00.000+0200"
                            
                            'Creating JSON - It looks scary but works
                            JSON = lfbrkt + flds + dbdots + " " + lfbrkt + _
                                vbCrLf + vbTab + prt + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + id + dbdots + " " + "30611" + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + smry + dbdots + " " + """" + customSubject + """" + cma + _
                                vbCrLf + vbTab + descrp + dbdots + " " + """" + customBody + """" + cma + _
                                vbCrLf + vbTab + issu + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + name + dbdots + " " + issuName + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + asgn + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + name + dbdots + " " + """" + recip.AddressEntry.GetExchangeUser().Alias + """" + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + startAt + dbdots + " " + """" + startDateString + """" + cma + _
                                vbCrLf + vbTab + endDate + dbdots + " " + """" + endDateString + """" + cma + _
                                vbCrLf + vbTab + label + dbdots + " " + sqLfBrkt + jiraLabel + sqRtBrkt + _
                                vbCrLf + rtbrkt + _
                                vbCrLf + rtbrkt
                                
                            'JIRA user
                            user = "username"
                            Password = "password"
                            
                            'Sending request to JIRA
                            Dim URL As String
                            URL = "https://jira.app.com/rest/api/2/issue/"
                            Set xhr = CreateObject("MSXML2.XMLHTTP.6.0")
                            xhr.Open "POST", URL, False
                            xhr.setRequestHeader "Content-Type", "application/json"
                            xhr.setRequestHeader "User-Agent", "Outlook"
                            xhr.setRequestHeader "Authorization", "Basic " + Base64Encode(user + ":" + Password)
                            xhr.Send JSON
                            
                        End If
                    Next
                    Set Change = myFolder.Folders("*** SPAM")
                    Item.Move Change
                End If
                counter = counter + 1
            End If
        End If
    Next

    MsgBox Inbox & ": " & counter & " Meetings accepted", vbOKOnly, ActiveFolder 'Infofeld
    
End Sub

Answer 1

"Why Are We Scared?"

The number one reason that we are scared of something is that we don't fully understand it. The key to understanding a complex problem is to break it down into small easy to understand units. The key to writing good code is to write small easy to understand and test (debug) subroutines.

Variable Declaration

I personally always use Option Explicit and declare the Type for each variable. This will give you the most information and the best feedback from the compiler.

I try and declare my variables in groups by type: Strings, Numeric, Objects, Outlook Objects, Excel Object at the top of the subroutine after any constants. Basically, whatever seems right for the code. I do it this way because I want my declarations to have a low profile and be separated from the logic of the subroutine. Ideally, I would like to be able to read the entire logic of a subroutine without having to scroll the code pane.

Repeated Logic

I am specifically referring to the use of Accept. As Raystafarian noted the name sucks, at least I think that was what he said. More importantly, the logic behind it is repeated several times.

Accept = False
If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then
    If ActiveFolder = "Application Management Linux1, I351" Then
       Accept = True
    End If

Since Accept is not used outside of the If Item.MessageClass... block I would simplify it like this:

Accept = ActiveFolder = "Application Management Linux1, I351"

Accept is then used on line 43:

If InStr(1, LCase(Item.Subject), "change") > 0 And Item.UnRead = True And Accept = True Then

But then on line 64 the same logic is used but without the Accept variable:

If ActiveFolder = "Application Management Linux1, I351" Then

But want the code from lines 43:60 is only relevant if it passes the Accept condition. So why don't lines 43:60 follow line 64???

Why not just get rid of the Accept variable like this:

If Item.MessageClass = "IPM.Schedule.Meeting.Request" And ActiveFolder = "Application Management Linux1, I351" Then

Not only will this simplify the code it will remove a nesting level making it easier to read.

---

Now this wouldn't be a Narcissistic Answer if I don't show my way of doing things. So here we go!!

---

Writing JSON and SQL Statements

There are plenty of good tools that help of write, format, and test our JSON and SQL statements. But what do we do? While until recently, I would spend a lot time writing code like & CHR(34) & UGH & CHR(34) & "This Sucks" & or """ & UGH & """This Sucks"""". Why not just not just write the JSON or SQL with the right tools copy their results to the CLipboard and process it from there.

Note: I use the @ sign to signify named parameters. I will later either use Replace(Text,"@Name",Name) or replace @ with " & " and then after the variable finish the concatenation with & ".

This is the first time I use JSONEditor and it only took about 10-12 minute to write ProcessClipboard().

Sub ProcessClipboard()
    Dim lines() As String, Text As String
    Dim x As Long
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        Text = .GetText
    End With

    Text = Replace(Text, Chr(34), String(2, 34))

    lines = Split(Text, Chr(10))

    For x = 0 To UBound(lines)
        Debug.Print "JSON(" & x & ") =", Chr(34); lines(x); Chr(34)
    Next
End Sub

JSON Editor Code

The Immediate Window raw output

This is a perfect example of why we you should use smaller functions and subroutines. Look how easy it is to test.

Refactored Code

Option Explicit

Public Sub AcceptMeeting(ActiveFolder As String, Inbox As String)
    Const SPAM_FOLDER As String = "*** SPAM"
    Dim jiraLabel As String
    Dim Item As Object, items As Collection, recip As Outlook.Recipient
    Dim AppointmentItem As Outlook.AppointmentItem
    Dim JSON As String

    If ActiveFolder = "Application Management Linux1, I351" Then

        Set items = getIPMMeetingRequests(ActiveFolder, Inbox)

        For Each Item In items
            DoEvents

            'Label for JIRA task
            If InStr(1, LCase(Item.Subject), "change") > 0 And Item.UnRead = True Then
                If InStr(1, LCase(Item.Subject), "produktion") > 0 Then
                    Item.Categories = "Change Produktion"    'Kategorie setzen PROD
                    jiraLabel = "Produktion"
                ElseIf InStr(1, LCase(Item.Subject), "integration") > 0 Then
                    Item.Categories = "Change Integration"    'Kategorie setzen INT
                    jiraLabel = "Integration"
                ElseIf InStr(1, LCase(Item.Subject), "test") > 0 Then
                    Item.Categories = "Change Integration"    'Kategorie setzen INT
                    jiraLabel = "Testing"
                Else
                    Item.Categories = "Change Info"   'Kategorie setzen Info
                    jiraLabel = "Info"
                End If

                'Accept Appointment
                Set AppointmentItem = Item.GetAssociatedAppointment(True)

                Item.UnRead = False

                'CustomReplace Msg.Body Msg.Subject
                For Each recip In Item.Recipients
                    If isValidAddressEntry(recip.AddressEntry) Then
                        'Creating JSON - Not so scary
                        JSON = getJSON(CustomReplace(Item.Subject), CustomReplace(Item.Body), _
                                       "Test", recip.AddressEntry.GetExchangeUser().Alias, _
                                       AppointmentItem.Start, AppointmentItem.End, "")

                        createJIRATask "username", "password", JSON
                    End If
                Next

                Item.Move Application.GetNamespace("MAPI").Folders(ActiveFolder).Folders(SPAM_FOLDER)

            End If
        Next

    End If
    MsgBox Inbox & ": " & items.Count & " Meetings accepted", vbOKOnly, ActiveFolder    'Infofeld

End Sub

Private Sub createJIRATask(User As String, Password As String, JSON As String)
'Sending request to JIRA
    Dim xhr As Object
    Dim URL As String
    URL = "https://jira.app.com/rest/api/2/issue/"
    Set xhr = CreateObject("MSXML2.XMLHTTP.6.0")
    xhr.Open "POST", URL, False
    xhr.setRequestHeader "Content-Type", "application/json"
    xhr.setRequestHeader "User-Agent", "Outlook"
    xhr.setRequestHeader "Authorization", "Basic " + Base64Encode(User + ":" + Password)
    xhr.Send JSON
End Sub

Private Function CustomReplace(Text As String) As String
    Text = Replace(Text, """", "'")
    Text = Replace(Text, vbCr & vbLf, "\n")
    Text = Replace(Text, vbCr, "\n")
    Text = Replace(Text, vbLf, "\n")
    CustomReplace = Text
End Function

Private Function getIPMMeetingRequests(FolderName As String, Inbox As String) As Collection
    Dim myFolder As Outlook.Folder, Folders As Outlook.Folders, Item As Object, Subfolder As Outlook.Folder
    Dim col As New Collection
    Set myFolder = Application.GetNamespace("MAPI").Folders(FolderName)
    Set Folders = myFolder.Folders

    Set Subfolder = Folders.Item(Inbox)
    For Each Item In Subfolder.items
        If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then
            col.Add Item
        End If
    Next
    Set getIPMMeetingRequests = col
End Function

Private Function getJSON(customSubject As String, customBody As String, issuName As String, recipAlias As String, appStartDateTime As Date, appEndDateTime As Date, jiraLabel As String) As String
    Dim JSON(19) As String, JSONText As String
    JSON(0) = "{"
    JSON(1) = "  ""fields"": {"
    JSON(2) = "    ""project"": {"
    JSON(3) = "      ""id"": 30611"
    JSON(4) = "    },"
    JSON(5) = "    ""summary"": ""@customSubject"","
    JSON(6) = "    ""description"": ""@customBody"","
    JSON(7) = "    ""issuetype"": {"
    JSON(8) = "      ""name"": ""@issuName"""
    JSON(9) = "    },"
    JSON(10) = "    ""assignee"": {"
    JSON(11) = "      ""name"": ""@recipAlias"""
    JSON(12) = "    },"
    JSON(13) = "    ""customfield_10021"": ""@appStartDateTime"","
    JSON(14) = "    ""customfield_12760"": ""@appEndDateTime"","
    JSON(15) = "    ""labels"": ["
    JSON(16) = "      ""@jiraLabel"""
    JSON(17) = "    ]"
    JSON(18) = "  }"
    JSON(19) = "}"

    JSONText = Join(JSON, vbNewLine)
    JSONText = Replace(JSONText, "@customSubject", customSubject)
    JSONText = Replace(JSONText, "@customBody", customBody)
    JSONText = Replace(JSONText, "@issuName", issuName)
    JSONText = Replace(JSONText, "@recipAlias", recipAlias)
    JSONText = Replace(JSONText, "@appStartDateTime", Format(appStartDateTime, "yyyy-mm-ddThh:mm:00.000+0200"))
    JSONText = Replace(JSONText, "@appEndDateTime", Format(appEndDateTime, "yyyy-mm-ddThh:mm:00.000+0200"))
    JSONText = Replace(JSONText, "@jiraLabel", jiraLabel)

    getJSON = JSONText
End Function

Private Function isValidAddressEntry(AddressEntry As String) As Boolean
    Dim regEx As New RegExp
    regEx.Pattern = "^\w+\s\w+,\sI351$"
    isValidAddressEntry = regEx.Test(AddressEntry) And AddressEntry <> "Application Management Linux1, I351"
End Function

Private Function Base64Encode(Text As String) As String
     '.... Not Provided
End Function

As always my code comes with a "3 Time Your Money Back Guarantee" minus $19.95 shipping and handling.

Answer 2

Variables

First, the variables folders, recips, xhr aren't defined.

When you don't define your variable, VBA will declare it as a Variant type that can hold any type of data. While this may be more flexible, it adds processing time to your macro as VBA decides or tests for the type. Additionally, since a Variant can be any type of data, you may miss out on valuable troubleshooting information on Type Mismatch.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

---

Also when you declare variables on the same line, you need to specify each variable's type -

Dim appStartDate, appStartTime, appEndDate, appEndTime As Date

This is what it's doing -

Dim appStartDate as Variant
Dim appStartTime as Variant
Dim appEndDate as Variant
Dim appEndTime as Date

Same thing happens here

Dim startDateString, endDateString As String

And here

Dim flds, prt, id, asgn, smry, descrp, issu, name, lfbrkt, rtbrkt, cma, _
dbdots, JSON, issuName, label, startAt, endDate, sqLfBrkt, sqRtBrkt As String

---

With that out of the way, your variable naming leaves a bit to be desired. Right now, looking at the code it is kind of difficult to know exactly what each variable is doing.

Dim myFolder As Outlook.Folder
Set myFolder = myNamespace.Folders(ActiveFolder)

Dim Folders
Set Folders = myFolder.Folders

Dim Subfolder As Outlook.Folder
Set Subfolder = Folders.Item(Inbox)

Dim Folder As Outlook.Folder 'I don't see this used

I'll make the assumption that the missing declaration of Folders was just supposed to be the variable Folder.

So MyFolder is the ActiveFolder. And Folders are the Folders in the ActiveFolder. And a SubFolder is some items?

So for all that jazz it basically comes down to the loop -

For Each Item In Application.GetNamespace("MAPI").Folders(ActiveFolder).Folders.Items(Inbox).Items

I think giving the namespace a variable is a good idea, but all those other folders can probably be combined into a single variable, which you iterate the item through, especially since all of that at the top is never referenced again.

The Change folder could just be spamFolder and set to the spam folder in the beginning, I don't see it reassigned anywhere.

I think myAppt and myMtg are okay, but why not just write the entire name out? The characters are free.

Dim Forward As Outlook.MeetingItem

This isn't used either, as far as I can see.

Dim Accept As Boolean

Usually with a boolean you want it to read like a boolean, like isTrue or isAccepted or shouldAccept - something like that makes it more clear.

---

Structure

It seems to be that the logic in this macro is broken up into a few things -

1. Find meeting requests
2. Categorize the request
3. Parse the request
4. Build the JSON
5. Send the JSON

Because that's the business logic, break it out into different procedures or functions to indicate what each part does. This makes it easier to follow, makes it simpler to review and allows you to refactor.

Sub FindMeetingRequests(ByVal targetFolder as Folder)
Sub ProcessMeetingRequests(ByVal item as Object)
Function BuildJSON(ByVal body as String) as String
Sub SubmitJSON(ByVal JSON as String)

This would be especially helpful when writing the JSON as your comment indicates - it looks scary. Break it out into its own function and then work on that function to make it seem less scary, or more manageable.

And since sending the HTTP request really doesn't have anything to do with the actual meeting request items, pull that out to its own procedure as well. Compartmentalize.

---

Constants

'Values to create JSON
                            Dim flds, prt, id, asgn, smry, descrp, issu, name, lfbrkt, rtbrkt, cma, _
                                dbdots, JSON, issuName, label, startAt, endDate, sqLfBrkt, sqRtBrkt As String
                            flds = """fields"""
                            prt = """project"""
                            id = """id"""
                            asgn = """assignee"""
                            smry = """summary"""
                            descrp = """description"""
                            issu = """issuetype"""
                            label = """labels"""
                            issuName = """Test"""
                            startAt = """customfield_10021"""
                            endDate = """customfield_12760"""
                            name = """name"""
                            lfbrkt = "{"
                            rtbrkt = "}"
                            cma = ","
                            dbdots = ":"
                            sqLfBrkt = "["
                            sqRtBrkt = "]"
Creating JSON - It looks scary but works
                            JSON = lfbrkt + flds + dbdots + " " + lfbrkt + _
                                vbCrLf + vbTab + prt + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + id + dbdots + " " + "30611" + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + smry + dbdots + " " + """" + customSubject + """" + cma + _
                                vbCrLf + vbTab + descrp + dbdots + " " + """" + customBody + """" + cma + _
                                vbCrLf + vbTab + issu + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + name + dbdots + " " + issuName + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + asgn + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + name + dbdots + " " + """" + recip.AddressEntry.GetExchangeUser().Alias + """" + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + startAt + dbdots + " " + """" + startDateString + """" + cma + _
                                vbCrLf + vbTab + endDate + dbdots + " " + """" + endDateString + """" + cma + _
                                vbCrLf + vbTab + label + dbdots + " " + sqLfBrkt + jiraLabel + sqRtBrkt + _
                                vbCrLf + rtbrkt + _
                                vbCrLf + rtbrkt

I applaud your efforts on creating those variables the way you did. It seems to me, however, that the majority of the JSON is a constant - I see the use of the dates, the subject, the body, etc. Maybe break those strings up into constant variables, like

Const JSON_BEFORE_SUBJECT as String = lfbrkt + flds + dbdots + " " + lfbrkt + _
                                vbCrLf + vbTab + prt + dbdots + " " + lfbrkt + _
                                    vbCrLf + vbTab + vbTab + id + dbdots + " " + "30611" + _
                                vbCrLf + vbTab + rtbrkt + cma + _
                                vbCrLf + vbTab + smry + dbdots + " " + """"

In a way you end up with something a lot less scary

JSON = JSON_BEFORE_SUBJECT & customSubject & JSON_BEFORE_BODY & customBody & JSON_BEFORE_ISSUE & issuName ....

Answer 3

My advice is very similar to what Narcissistic Answers posted, so I don't have a ton to add. Using multiple small/single-purpose functions is almost always better than using one long/complex sub, which their answer demonstrated very well.

One thing to keep in mind when you're making "helper" functions is whether you may want to reuse them in another project. Take a look at this function from Narcissistic Answers' implementation:

Private Function getIPMMeetingRequests(FolderName As String, Inbox As String) As Collection

    Dim myFolder As Outlook.Folder
    Dim Folders As Outlook.Folders
    Dim Item As Object
    Dim Subfolder As Outlook.Folder
    Dim col As New Collection

    Set myFolder = Application.GetNamespace("MAPI").Folders(FolderName)
    Set Folders = myFolder.Folders
    Set Subfolder = Folders.Item(Inbox)

    For Each Item In Subfolder.items
        If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then
            col.Add Item
        End If
    Next

    Set getIPMMeetingRequests = col

End Function

The function is incredibly specific to this particular problem. It can only loop through a folder ("FolderName") that has a subfolder ("Inbox"), and it can only look for "IPM.Schedule.Meeting.Request" items.

With a few tweaks, however, you can make the function general enough to reuse in a variety of situations:

Function getItems(folder As Outlook.Folder, itemType As String) As Collection

    Dim item As Object
    Dim results As New Collection
    For Each item In folder.Items
        If item.MessageClass = itemType Then
            results.Add Item
        End If
    Next
    Set getItems = results

End Function

And if you're really thinking ahead, you can make the function incredibly flexible. You could specify more than one item type, use partial/wildcard matches when checking the item types, or even loop through more than one folder at once:

Function getItems(folders As Variant, itemTypes As Variant) As Collection
'Loops through one or more outlook folders (folders), which can be passed as:
'    - An Outlook.Folder object, 
'    - An array of Outlook.Folder objects, or
'    - An Outlook.Folders Collection
'Adds items that meet one or more type criteria (itemTypes), which can be passed as:
'    - A string, or
'    - An array of strings

    Dim objects As Variant
    If IsArray(folders) Then
        objects = folders
    ElseIf TypeOf folders Is Outlook.Folders Then
        Set objects = folders
    ElseIf TypeOf folders Is Outlook.Folder Then
        ReDim objects(1 To 1) As Variant
        Set objects(1) = folders
    Else
        Exit Function
    End If

    Dim types As Variant
    If IsArray(itemTypes) Then
        types = itemTypes
    ElseIf Not IsObject(itemTypes) then
        ReDim types(1 To 1) As String
        types(1) = CStr(itemTypes)
    Else
        Exit Function
    End If

    Dim results As New Collection
    Dim elem As Variant
    For Each elem In objects
        Dim item As Object
        For Each item In elem.Items
            Dim i As Long
            For i = LBound(types) To UBound(types)
                If item.MessageClass Like types(i) Then
                    results.Add Item
                    Exit For
                End If
            Next
        Next
    Next
    Set getItems = results

End Function

The other thing I'll mention is to watch out for instances where a function is unnecessarily called in every iteration of a loop. In Narcissistic Answers' post, the function that formats the Subject/Body portions of the JSON string is called once for every recipient:

For Each recip In Item.Recipients
    If isValidAddressEntry(recip.AddressEntry) Then
        'Creating JSON - Not so scary
        JSON = getJSON( _
                   CustomReplace(Item.Subject), _
                   CustomReplace(Item.Body), _
                   "Test", _
                   recip.AddressEntry.GetExchangeUser().Alias, _
                   AppointmentItem.Start, _
                   AppointmentItem.End, _
                   "")

        createJIRATask "username", "password", JSON
    End If
Next

However, these strings are determined by the Item, not the recipient, so they should be formatted before entering the inner loop. That way you just have to format them once.

In this particular case, it's not a huge deal. But it's good practice to watch out for unnecessary function calls.

EDIT: Adding the full version of how I'd recommend approaching the problem.

Sub AcceptMeeting(ActiveFolder As String, Inbox As String)

    If Not ActiveFolder = "Application Management Linux1, I351" Then
        Exit Sub
    End If

    'Set up objects used in each pass of outer loop
    Dim myFolder As Outlook.Folder
    Dim regEx As New RegExp
    Set myFolder = Application.GetNamespace("MAPI").Folders(ActiveFolder)
    regEx.Pattern = "^\w+\s\w+,\sI351$"

    'Get collection of meeting items and loop through
    Dim i As Long
    Dim message As Object
    Dim messages As Collection
    Set messages = getItems(myFolder.Folders.Item(Inbox), "IPM.Schedule.Meeting.Request")
    For Each message In messages
        'Determine if message fits criteria
        If InStr(LCase(message.Subject), "change") > 0 And message.UnRead Then
            'Accept appointment
            Dim appt As Outlook.AppointmentItem
            Set appt = message.GetAssociatedAppointment(True)
            appt.Respond olResponseAccepted, True
            message.UnRead = False

            'Format JSON components for message by removing illegal characters and surrounding elements with quotes
            'Since they stay the same for each pass of inner loop...
            '...doing it here saves execution time
            Dim jiraLabel As String
            Dim customBody As String
            Dim customSubject As String
            Dim startDate As String
            Dim endDate As String
            jiraLabel = parseSubject(message)
            customBody = formatForJSON(message.Body)
            customSubject = formatForJSON(message.Subject)
            startDate = formatDate(appt.Start)
            endDate = formatDate(appt.End)

            'Send response for each matching recipient
            Dim recipient As Outlook.Recipient
            For Each recipient In message.Recipients
                If addressMatches(recipient.AddressEntry, regEx) Then
                    Dim JSON As String
                    JSON = createJSON( _
                        exchangeID:="""" & recipient.AddressEntry.GetExchangeUser().Alias & """", _
                        label:=jiraLabel, _
                        subject:=customSubject, _
                        body:=customBody, _
                        startDate:=startDate, _
                        endDate:=endDate)

                    Call sendJIRA(JSON, "username", "password")
                End If
            Next
            message.Move myfolder.Folders("*** SPAM")
            i = i + 1
        End If
    Next

    MsgBox Inbox & ": " & i & " Meetings accepted", vbOKOnly, ActiveFolder

End Sub
Function getItems(folders As Variant, itemTypes As Variant) As Collection
'Loops through one or more outlook folders (folders), which can be passed as:
'    - An Outlook.Folder object, 
'    - An array of Outlook.Folder objects, or
'    - An Outlook.Folders Collection
'Adds items that meet one or more type criteria (itemTypes), which can be passed as:
'    - A string, or
'    - An array of strings

    Dim objects As Variant
    If IsArray(folders) Then
        objects = folders
    ElseIf TypeOf folders Is Outlook.Folders Then
        Set objects = folders
    ElseIf TypeOf folders Is Outlook.Folder Then
        ReDim objects(1 To 1) As Variant
        Set objects(1) = folders
    Else
        Exit Function
    End If

    Dim types As Variant
    If IsArray(itemTypes) Then
        types = itemTypes
    ElseIf Not IsObject(itemTypes) then
        ReDim types(1 To 1) As String
        types(1) = CStr(itemTypes)
    Else
        Exit Function
    End If

    Dim results As New Collection
    Dim elem As Variant
    For Each elem In objects
        Dim item As Object
        For Each item In elem.Items
            Dim i As Long
            For i = LBound(types) To UBound(types)
                If item.MessageClass Like types(i) Then
                    results.Add Item
                    Exit For
                End If
            Next
        Next
    Next
    Set getItems = results

End Function
Function parseSubject(obj As Object) As String

    Dim subjectText As String
    Dim itemLabel As String
    subjectText = LCase(obj.Subject)

    If InStr(subjectText), "produktion") > 0 Then
        obj.Categories = "Change Produktion"
        itemLabel = "Produktion"
    ElseIf InStr(subjectText), "integration") > 0 Then
        obj.Categories = "Change Integration"
        itemLabel = "Integration"
    ElseIf InStr(subjectText, "test") > 0 Then
        obj.Categories = "Change Integration"
        itemLabel = "Testing"
    Else
        obj.Categories = "Change Info"
        itemLabel = "Info"
    End If

    parseSubject = """" & itemLabel & """"

End Function
Function formatForJSON(str As String) As String

    Dim resultStr As String
    resultStr = Replace(str, """", "'")
    resultStr = Replace(resultStr, vbCr & vbLf, "\n")
    resultStr = Replace(resultStr, vbCr, "\n")
    resultStr = Replace(resultStr, vbLf, "\n")
    formatForJSON = """" & resultStr & """"

End Function
Function createJSON(exchangeID As String, label As String, subject As String, _
                    body As String, startDate As String, endDate As String) As String

    Dim JSON As String
    JSON = JSON & "{""fields: {" & vbCrLf
    JSON = JSON & "    ""project"": {" & vbCrLf
    JSON = JSON & "        ""id"": 30611" & vbCrLf
    JSON = JSON & "    }," & vbCrLf
    JSON = JSON & "    ""summary"": " & subject & "," & vbCrLf
    JSON = JSON & "    ""description"": " & body & "," & vbCrLf
    JSON = JSON & "    ""issuetype"": {" & vbCrLf
    JSON = JSON & "        ""name"": " & exchangeID & vbCrLf
    JSON = JSON & "    }," & vbCrLf
    JSON = JSON & "    ""customfield_10021"": " & startDate & "," & vbCrLf
    JSON = JSON & "    ""customfield_12760"": " & endDate & "," & vbCrLf
    JSON = JSON & "    ""labels"": [" & label & "]" & vbCrLf
    JSON = JSON & "}" & vbCrLf & "}"

    createJSON = JSON

End Function
Function formatDate(dt As Date) As String

    formatDate = """" & Format(dt, "yyyy-mm-dd") & "T" & _
                 Format(dt, "hh:mm") & ":00.000+0200" & """"

End Function
Sub sendJIRA(JSON As String, username As String, pw As String)

    Dim URL As String
    URL = "https://jira.app.com/rest/api/2/issue/"
    Set xhr = CreateObject("MSXML2.XMLHTTP.6.0")
    xhr.Open "POST", URL, False
    xhr.setRequestHeader "Content-Type", "application/json"
    xhr.setRequestHeader "User-Agent", "Outlook"
    xhr.setRequestHeader "Authorization", "Basic " + Base64Encode(username & ":" & pw)
    xhr.Send JSON

End Sub
Function addressMatches(address As String, regEx As RegExp) As Boolean

    If address = "Application Management Linux1, I351" Then
        addressMatches = False
    Else
        addressMatches = regEx.Test(address)
    End If

End Function