Query Rapidboard Sprint Attributes as XML

O. Funkhouser

I currently have an Excel spreadsheet that tracks high-level milestones that are linked against JIRA issues. I have a VBA script that executes the following URL and it parses the XML to extract dates, actual work, remaining work, status, resolution, etc.:

Dim MyRequest As New WinHttpRequest
Dim resultXml As MSXML2.DOMDocument, resultNode As IXMLDOMElement
MyRequest.Open "GET", _
               "https://my.jira.location/si/jira.issueviews:issue-xml/" & jiraIssue & "/" & jiraIssue & ".xml"
MyRequest.setRequestHeader "Authorization", "Basic " & EncodeBase64(userName & ":" & password)
MyRequest.setRequestHeader "Content-Type", "application/xml"
MyRequest.Send
Set resultXml = New MSXML2.DOMDocument
resultXml.LoadXML MyRequest.ResponseText

This works great! I also have Agile RapidBoard Sprints listed in this spreadsheet. Is there a way to programmatically query JIRA (using VBA like above) to get the start date, end date, original work estimate, current work estimate, and actual work completed associated with a sprint?

O. Funkhouser

Well, I found a way to do it using JSON but not XML. I have been successful at getting the start date and end date by parsing the "sprintreport" JSON results. I parsed the current work estimate and actual work from the "scopechangeburndownchart" JSON results. The latter wasn't very straightforward as it appears that the scopechangeburndownchart returns work logs for items outside the dates of the sprint as well as inside the sprint dates; so I had to do some additional filtering. The estimated work remaining lines up 100% with what the Sprint Burndown UI Chart says. The time spent is close but doesn't match 100%; I havent' figured out why just yet.

Here is the code for those who may be interested. It uses code from the VBA JSON project. I have not cleaned it up yet but will do so as time allows.

JiraSprintContents Class Module:

Public name As String
Public startDate As String
Public endDate As String
Public status As String
Public sumTimeSpent As String
Public sumTimeRemaining As String
Public isValid As Boolean ' Set this to true if the JIRA finds the sprint, false otherwise
Public errorString As String

Private Function extractSprintContents(jiraUrl As String, userName As String, password As String, ByVal rapidBoardId As String, ByVal sprintId As String) As JiraSprintContents
    
    Dim JiraService As New MSXML2.XMLHTTP60
    Dim JiraAuth As New MSXML2.XMLHTTP60
    Dim sprintDetailsResult As String
    Dim sprintBurndownResult As String
    Dim MyRequest As New WinHttpRequest
    Dim resultXml As MSXML2.DOMDocument, resultNode As IXMLDOMElement
    Dim sprintDetails As Dictionary
    Dim burndownDetails As Dictionary
    Dim issueDetailsCache As New Dictionary
    Dim tempDate() As String
    Dim tempJsonIssue As Dictionary
    Dim tempIssueWorkDetails As JiraIssueWorkDetails
    Dim tempIssueId As String
    Dim sprintStartEpochMilliseconds As Double
    Dim sprintEndEpochMilliseconds As Double
    Dim tempChangeDate As Double
    Dim tempTimeRemaining As Double
    Dim tempTimeSpent As Double
        
    tempTimeRemaining = 0#
    tempTimeSpent = 0#

    ' Query JIRA for sprint details
    MyRequest.Open "GET", _
                   jiraUrl & "/rest/greenhopper/1.0/rapid/charts/sprintreport?rapidViewId=" & rapidBoardId & "&sprintId=" & sprintId
    MyRequest.setRequestHeader "Authorization", "Basic " & EncodeBase64(userName & ":" & password)
    MyRequest.setRequestHeader "Content-Type", "application/json"
    MyRequest.Send
    sprintDetailsResult = MyRequest.ResponseText
    
    Set extractSprintContents = New JiraSprintContents
 
    Set sprintDetails = parse(sprintDetailsResult)
    
    If (sprintDetails.Exists("sprint")) Then
        extractSprintContents.isValid = True
        
        ' Get start date of sprint
        If (sprintDetails.Item("sprint").Exists("startDate")) Then
            tempDate = Split(sprintDetails.Item("sprint").Item("startDate"), " ")
            extractSprintContents.startDate = tempDate(0)
        End If
        ' Get end date of sprint
        If (sprintDetails.Item("sprint").Exists("endDate")) Then
            tempDate = Split(sprintDetails.Item("sprint").Item("endDate"), " ")
            extractSprintContents.endDate = tempDate(0)
        End If
        ' Get sprint name
        If (sprintDetails.Item("sprint").Exists("name")) Then
            extractSprintContents.name = sprintDetails.Item("sprint").Item("name")
        End If
        ' Get sprint status
        If (sprintDetails.Item("sprint").Exists("state")) Then
            Select Case sprintDetails.Item("sprint").Item("state")
                Case "CLOSED"
                    extractSprintContents.status = "Closed"
                Case "ACTIVE"
                    extractSprintContents.status = "Active"
                Case "FUTURE"
                    extractSprintContents.status = "Future"
                Case Else
                    extractSprintContents.status = sprintDetails.Item("sprint").Item("state")
            End Select
        End If
        
        ' Convert start and end dates to Epoch in milliseconds (used later for
        ' calculated time spent in the sprint
        ' sprintStartEpochMilliseconds
        If Len(extractSprintContents.startDate) > 6 Then
            sprintStartEpochMilliseconds = DateDiff("s", #1/1/1970#, extractSprintContents.startDate) * 1000
        Else
            sprintStartEpochMilliseconds = DateDiff("s", #1/1/1970#, Now()) * 1000
        End If
        If Len(extractSprintContents.endDate) > 6 Then
            sprintEndEpochMilliseconds = DateDiff("s", #1/1/1970#, extractSprintContents.endDate) * 1000
        Else
            sprintEndEpochMilliseconds = DateDiff("s", #1/1/1970#, Now()) * 1000
        End If
        
        ' Parse the scope change burndown chart to sum the work performed in this sprint
        ' as well as sum the remaining work at the end of the sprint.
        Set MyRequest = New WinHttpRequest
        MyRequest.Open "GET", _
                       jiraUrl & "/rest/greenhopper/1.0/rapid/charts/scopechangeburndownchart?rapidViewId=" & rapidBoardId & "&sprintId=" & sprintId
        MyRequest.setRequestHeader "Authorization", "Basic " & EncodeBase64(userName & ":" & password)
        MyRequest.setRequestHeader "Content-Type", "application/json"
        MyRequest.Send
        sprintBurndownResult = MyRequest.ResponseText
   
        Set burndownDetails = parse(sprintBurndownResult)
        
       
        If burndownDetails.Exists("changes") Then
            ' Loop through details, create a structure for each issue.
            ' 1. Add work completed to the issue structure
            ' 2. Store the remaining estimate to the issue structure
            For Each strKey In burndownDetails.Item("changes").keys
            
                For index = 1 To burndownDetails.Item("changes").Item(strKey).Count
                    
                    Set tempJsonIssue = burndownDetails.Item("changes").Item(strKey).Item(index)
                    
                    If tempJsonIssue.Exists("timeC") Then
                        tempIssueId = tempJsonIssue.Item("key")
                    
                        ' Create JiraIssueWorkDetails or pull from cache
                        If issueDetailsCache.Exists(tempIssueId) Then
                            Set tempIssueWorkDetails = issueDetailsCache.Item(tempIssueId)
                        Else
                            Set tempIssueWorkDetails = New JiraIssueWorkDetails
                            tempIssueWorkDetails.issueId = tempIssueId
                            issueDetailsCache.Add tempIssueId, tempIssueWorkDetails
                        End If
                        
                        ' Extract newEstimate and store to issue
                        If tempJsonIssue.Item("timeC").Exists("newEstimate") Then
                            tempIssueWorkDetails.workRemaining = tempJsonIssue.Item("timeC").Item("newEstimate") / 3600
                        End If
                        
                        ' Extract date and verify that it is within Sprint dates
                        If tempJsonIssue.Item("timeC").Exists("changeDate") And _
                           tempJsonIssue.Item("timeC").Exists("timeSpent") Then
                           
                            tempChangeDate = tempJsonIssue.Item("timeC").Item("changeDate") * 1
                            If (tempChangeDate >= sprintStartEpochMilliseconds) And _
                               (tempChangeDate <= sprintEndEpochMilliseconds) Then
                               
                                tempIssueWorkDetails.workLogged = tempIssueWorkDetails.workLogged + _
                                    tempJsonIssue.Item("timeC").Item("timeSpent") / 3600

                            End If
                            
                        End If
                    End If
                Next index
            Next
            
            ' Now loop through all issues in the cache and sum up time work and time remaining
            For Each issueWorkDetails In issueDetailsCache.Items
                tempTimeRemaining = tempTimeRemaining + issueWorkDetails.workRemaining
                tempTimeSpent = tempTimeSpent + issueWorkDetails.workLogged
            Next
            
            extractSprintContents.sumTimeRemaining = tempTimeRemaining
            extractSprintContents.sumTimeSpent = tempTimeSpent

        End If
    Else
        extractSprintContents.isValid = False
        extractSprintContents.errorString = sprintDetailsResult
    End If
 
End Function

Public Function EncodeBase64(text As String) As String
    Dim arrData() As Byte
    arrData = StrConv(text, vbFromUnicode)

    Dim objXML As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMElement

    Set objXML = New MSXML2.DOMDocument
    Set objNode = objXML.createElement("b64")

    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = arrData
    EncodeBase64 = objNode.text

    Set objNode = Nothing
    Set objXML = Nothing
End Function


' VBJSON is a VB6 adaptation of the VBA JSON project at http://code.google.com/p/vba-json/
' Some bugs fixed, speed improvements added for VB6 by Michael Glaser (vbjson@ediy.co.nz)
' BSD Licensed

Public Function GetParserErrors() As String
   GetParserErrors = psErrors
End Function

Public Function ClearParserErrors() As String
   psErrors = ""
End Function


'
'   parse string and create JSON object
'
Public Function parse(ByRef str As String) As Object

   Dim index As Long
   index = 1
   psErrors = ""
   On Error Resume Next
   Call skipChar(str, index)
   Select Case Mid(str, index, 1)
      Case "{"
         Set parse = parseObject(str, index)
      Case "["
         Set parse = parseArray(str, index)
      Case Else
         psErrors = "Invalid JSON"
   End Select


End Function

 '
 '   parse collection of key/value
 '
Private Function parseObject(ByRef str As String, ByRef index As Long) As Dictionary

   Set parseObject = New Dictionary
   Dim sKey As String
   
   ' "{"
   Call skipChar(str, index)
   If Mid(str, index, 1) <> "{" Then
      psErrors = psErrors & "Invalid Object at position " & index & " : " & Mid(str, index) & vbCrLf
      Exit Function
   End If
   
   index = index + 1

   Do
      Call skipChar(str, index)
      If "}" = Mid(str, index, 1) Then
         index = index + 1
         Exit Do
      ElseIf "," = Mid(str, index, 1) Then
         index = index + 1
         Call skipChar(str, index)
      ElseIf index > Len(str) Then
         psErrors = psErrors & "Missing '}': " & Right(str, 20) & vbCrLf
         Exit Do
      End If

      
      ' add key/value pair
      sKey = parseKey(str, index)
      On Error Resume Next
      
      parseObject.Add sKey, parseValue(str, index)
      If Err.Number <> 0 Then
         psErrors = psErrors & Err.Description & ": " & sKey & vbCrLf
         Exit Do
      End If
   Loop
eh:

End Function

'
'   parse list
'
Private Function parseArray(ByRef str As String, ByRef index As Long) As Collection

   Set parseArray = New Collection

   ' "["
   Call skipChar(str, index)
   If Mid(str, index, 1) <> "[" Then
      psErrors = psErrors & "Invalid Array at position " & index & " : " + Mid(str, index, 20) & vbCrLf
      Exit Function
   End If
   
   index = index + 1

   Do

      Call skipChar(str, index)
      If "]" = Mid(str, index, 1) Then
         index = index + 1
         Exit Do
      ElseIf "," = Mid(str, index, 1) Then
         index = index + 1
         Call skipChar(str, index)
      ElseIf index > Len(str) Then
         psErrors = psErrors & "Missing ']': " & Right(str, 20) & vbCrLf
         Exit Do
      End If

      ' add value
      On Error Resume Next
      parseArray.Add parseValue(str, index)
      If Err.Number <> 0 Then
         psErrors = psErrors & Err.Description & ": " & Mid(str, index, 20) & vbCrLf
         Exit Do
      End If
   Loop

End Function

'
'   parse string / number / object / array / true / false / null
'
Private Function parseValue(ByRef str As String, ByRef index As Long)

   Call skipChar(str, index)

   Select Case Mid(str, index, 1)
      Case "{"
         Set parseValue = parseObject(str, index)
      Case "["
         Set parseValue = parseArray(str, index)
      Case """", "'"
         parseValue = parseString(str, index)
      Case "t", "f"
         parseValue = parseBoolean(str, index)
      Case "n"
         parseValue = parseNull(str, index)
      Case Else
         parseValue = parseNumber(str, index)
   End Select

End Function

'
'   parse string
'
Private Function parseString(ByRef str As String, ByRef index As Long) As String

   Dim quote   As String
   Dim Char    As String
   Dim Code    As String

   Dim SB As String

   Call skipChar(str, index)
   quote = Mid(str, index, 1)
   index = index + 1
   
   Do While index > 0 And index <= Len(str)
      Char = Mid(str, index, 1)
      Select Case (Char)
         Case "\"
            index = index + 1
            Char = Mid(str, index, 1)
            Select Case (Char)
               Case """", "\", "/", "'"
                  SB = SB & Char
                  index = index + 1
               Case "b"
                  SB = SB & vbBack
                  index = index + 1
               Case "f"
                  SB = SB & vbFormFeed
                  index = index + 1
               Case "n"
                  SB = SB & vbLf
                  index = index + 1
               Case "r"
                  SB = SB & vbCr
                  index = index + 1
               Case "t"
                  SB = SB & vbTab
                  index = index + 1
               Case "u"
                  index = index + 1
                  Code = Mid(str, index, 4)
                  SB = SB & ChrW(Val("&h" + Code))
                  index = index + 4
            End Select
         Case quote
            index = index + 1
            
            parseString = SB
            
            Exit Function
            
         Case Else
            SB = SB & Char
            index = index + 1
      End Select
   Loop
   
   parseString = SB
   
End Function

'
'   parse number
'
Private Function parseNumber(ByRef str As String, ByRef index As Long)

   Dim Value   As String
   Dim Char    As String

   Call skipChar(str, index)
   Do While index > 0 And index <= Len(str)
      Char = Mid(str, index, 1)
      If InStr("+-0123456789.eE", Char) Then
         Value = Value & Char
         index = index + 1
      Else
         parseNumber = CDec(Value)
         Exit Function
      End If
   Loop
End Function

'
'   parse true / false
'
Private Function parseBoolean(ByRef str As String, ByRef index As Long) As Boolean

   Call skipChar(str, index)
   If Mid(str, index, 4) = "true" Then
      parseBoolean = True
      index = index + 4
   ElseIf Mid(str, index, 5) = "false" Then
      parseBoolean = False
      index = index + 5
   Else
      psErrors = psErrors & "Invalid Boolean at position " & index & " : " & Mid(str, index) & vbCrLf
   End If

End Function

'
'   parse null
'
Private Function parseNull(ByRef str As String, ByRef index As Long)

   Call skipChar(str, index)
   If Mid(str, index, 4) = "null" Then
      parseNull = Null
      index = index + 4
   Else
      psErrors = psErrors & "Invalid null value at position " & index & " : " & Mid(str, index) & vbCrLf
   End If

End Function

Private Function parseKey(ByRef str As String, ByRef index As Long) As String

   Dim dquote  As Boolean
   Dim squote  As Boolean
   Dim Char    As String

   Call skipChar(str, index)
   Do While index > 0 And index <= Len(str)
      Char = Mid(str, index, 1)
      Select Case (Char)
         Case """"
            dquote = Not dquote
            index = index + 1
            If Not dquote Then
               Call skipChar(str, index)
               If Mid(str, index, 1) <> ":" Then
                  psErrors = psErrors & "Invalid Key at position " & index & " : " & parseKey & vbCrLf
                  Exit Do
               End If
            End If
         Case "'"
            squote = Not squote
            index = index + 1
            If Not squote Then
               Call skipChar(str, index)
               If Mid(str, index, 1) <> ":" Then
                  psErrors = psErrors & "Invalid Key at position " & index & " : " & parseKey & vbCrLf
                  Exit Do
               End If
            End If
         Case ":"
            index = index + 1
            If Not dquote And Not squote Then
               Exit Do
            Else
               parseKey = parseKey & Char
            End If
         Case Else
            If InStr(vbCrLf & vbCr & vbLf & vbTab & " ", Char) Then
            Else
               parseKey = parseKey & Char
            End If
            index = index + 1
      End Select
   Loop

End Function

'
'   skip special character
'
Private Sub skipChar(ByRef str As String, ByRef index As Long)
   Dim bComment As Boolean
   Dim bStartComment As Boolean
   Dim bLongComment As Boolean
   Do While index > 0 And index <= Len(str)
      Select Case Mid(str, index, 1)
      Case vbCr, vbLf
         If Not bLongComment Then
            bStartComment = False
            bComment = False
         End If
         
      Case vbTab, " ", "(", ")"
         
      Case "/"
         If Not bLongComment Then
            If bStartComment Then
               bStartComment = False
               bComment = True
            Else
               bStartComment = True
               bComment = False
               bLongComment = False
            End If
         Else
            If bStartComment Then
               bLongComment = False
               bStartComment = False
               bComment = False
            End If
         End If
         
      Case "*"
         If bStartComment Then
            bStartComment = False
            bComment = True
            bLongComment = True
         Else
            bStartComment = True
         End If
         
      Case Else
         If Not bComment Then
            Exit Do
         End If
      End Select
      
      index = index + 1
   Loop

End Sub

Public Function toString(ByRef obj As Variant) As String
   Dim SB As New cStringBuilder
   Select Case VarType(obj)
      Case vbNull
         SB.Append "null"
      Case vbDate
         SB.Append """" & CStr(obj) & """"
      Case vbString
         SB.Append """" & Encode(obj) & """"
      Case vbObject
         
         Dim bFI As Boolean
         Dim i As Long
         
         bFI = True
         If TypeName(obj) = "Dictionary" Then

            SB.Append "{"
            Dim keys
            keys = obj.keys
            For i = 0 To obj.Count - 1
               If bFI Then bFI = False Else SB.Append ","
               Dim key
               key = keys(i)
               SB.Append """" & key & """:" & toString(obj.Item(key))
            Next i
            SB.Append "}"

         ElseIf TypeName(obj) = "Collection" Then

            SB.Append "["
            Dim Value
            For Each Value In obj
               If bFI Then bFI = False Else SB.Append ","
               SB.Append toString(Value)
            Next Value
            SB.Append "]"

         End If
      Case vbBoolean
         If obj Then SB.Append "true" Else SB.Append "false"
      Case vbVariant, vbArray, vbArray + vbVariant
         Dim sEB
         SB.Append multiArray(obj, 1, "", sEB)
      Case Else
         SB.Append Replace(obj, ",", ".")
   End Select

   toString = SB.toString
   Set SB = Nothing
   
End Function

Private Function Encode(str) As String

   Dim SB As New cStringBuilder
   Dim i As Long
   Dim j As Long
   Dim aL1 As Variant
   Dim aL2 As Variant
   Dim c As String
   Dim p As Boolean

   aL1 = Array(&H22, &H5C, &H2F, &H8, &HC, &HA, &HD, &H9)
   aL2 = Array(&H22, &H5C, &H2F, &H62, &H66, &H6E, &H72, &H74)
   For i = 1 To Len(str)
      p = True
      c = Mid(str, i, 1)
      For j = 0 To 7
         If c = Chr(aL1(j)) Then
            SB.Append "\" & Chr(aL2(j))
            p = False
            Exit For
         End If
      Next

      If p Then
         Dim a
         a = AscW(c)
         If a > 31 And a < 127 Then
            SB.Append c
         ElseIf a > -1 Or a < 65535 Then
            SB.Append "\u" & String(4 - Len(Hex(a)), "0") & Hex(a)
         End If
      End If
   Next
   
   Encode = SB.toString
   Set SB = Nothing
   
End Function

Private Function multiArray(aBD, iBC, sPS, ByRef sPT)   ' Array BoDy, Integer BaseCount, String PoSition
   
   Dim iDU As Long
   Dim iDL As Long
   Dim i As Long
   
   On Error Resume Next
   iDL = LBound(aBD, iBC)
   iDU = UBound(aBD, iBC)

   Dim SB As New cStringBuilder

   Dim sPB1, sPB2  ' String PointBuffer1, String PointBuffer2
   If Err.Number = 9 Then
      sPB1 = sPT & sPS
      For i = 1 To Len(sPB1)
         If i <> 1 Then sPB2 = sPB2 & ","
         sPB2 = sPB2 & Mid(sPB1, i, 1)
      Next
      '        multiArray = multiArray & toString(Eval("aBD(" & sPB2 & ")"))
      SB.Append toString(aBD(sPB2))
   Else
      sPT = sPT & sPS
      SB.Append "["
      For i = iDL To iDU
         SB.Append multiArray(aBD, iBC + 1, i, sPT)
         If i < iDU Then SB.Append ","
      Next
      SB.Append "]"
      sPT = Left(sPT, iBC - 2)
   End If
   Err.Clear
   multiArray = SB.toString
   
   Set SB = Nothing
End Function

' Miscellaneous JSON functions

Public Function StringToJSON(st As String) As String
   
   Const FIELD_SEP = "~"
   Const RECORD_SEP = "|"

   Dim sFlds As String
   Dim sRecs As New cStringBuilder
   Dim lRecCnt As Long
   Dim lFld As Long
   Dim fld As Variant
   Dim rows As Variant

   lRecCnt = 0
   If st = "" Then
      StringToJSON = "null"
   Else
      rows = Split(st, RECORD_SEP)
      For lRecCnt = LBound(rows) To UBound(rows)
         sFlds = ""
         fld = Split(rows(lRecCnt), FIELD_SEP)
         For lFld = LBound(fld) To UBound(fld) Step 2
            sFlds = (sFlds & IIf(sFlds <> "", ",", "") & """" & fld(lFld) & """:""" & toUnicode(fld(lFld + 1) & "") & """")
         Next 'fld
         sRecs.Append IIf((Trim(sRecs.toString) <> ""), "," & vbCrLf, "") & "{" & sFlds & "}"
      Next 'rec
      StringToJSON = ("( {""Records"": [" & vbCrLf & sRecs.toString & vbCrLf & "], " & """RecordCount"":""" & lRecCnt & """ } )")
   End If
End Function


Public Function RStoJSON(rs As ADODB.Recordset) As String
   On Error GoTo errHandler
   Dim sFlds As String
   Dim sRecs As New cStringBuilder
   Dim lRecCnt As Long
   Dim fld As ADODB.Field

   lRecCnt = 0
   If rs.State = adStateClosed Then
      RStoJSON = "null"
   Else
      If rs.EOF Or rs.BOF Then
         RStoJSON = "null"
      Else
         Do While Not rs.EOF And Not rs.BOF
            lRecCnt = lRecCnt + 1
            sFlds = ""
            For Each fld In rs.Fields
               sFlds = (sFlds & IIf(sFlds <> "", ",", "") & """" & fld.name & """:""" & toUnicode(fld.Value & "") & """")
            Next 'fld
            sRecs.Append IIf((Trim(sRecs.toString) <> ""), "," & vbCrLf, "") & "{" & sFlds & "}"
            rs.MoveNext
         Loop
         RStoJSON = ("( {""Records"": [" & vbCrLf & sRecs.toString & vbCrLf & "], " & """RecordCount"":""" & lRecCnt & """ } )")
      End If
   End If

   Exit Function
errHandler:

End Function

Public Function toUnicode(str As String) As String

   Dim x As Long
   Dim uStr As New cStringBuilder
   Dim uChrCode As Integer

   For x = 1 To Len(str)
      uChrCode = Asc(Mid(str, x, 1))
      Select Case uChrCode
         Case 8:   ' backspace
            uStr.Append "\b"
         Case 9: ' tab
            uStr.Append "\t"
         Case 10:  ' line feed
            uStr.Append "\n"
         Case 12:  ' formfeed
            uStr.Append "\f"
         Case 13: ' carriage return
            uStr.Append "\r"
         Case 34: ' quote
            uStr.Append "\"""
         Case 39:  ' apostrophe
            uStr.Append "\'"
         Case 92: ' backslash
            uStr.Append "\\"
         Case 123, 125:  ' "{" and "}"
            uStr.Append ("\u" & Right("0000" & Hex(uChrCode), 4))
         Case Is < 32, Is > 127: ' non-ascii characters
            uStr.Append ("\u" & Right("0000" & Hex(uChrCode), 4))
         Case Else
            uStr.Append Chr$(uChrCode)
      End Select
   Next
   toUnicode = uStr.toString
   Exit Function

End Function

Private Sub Class_Initialize()
   psErrors = ""
End Sub