#4 Incorrect parsing of the original RTF body to get the header

[Matej Mihelic]

[Also related to "Outlook 2010 - ID: 3280971"]

The RTF parsing in the "ColorizeMailItem" function is written using the hardcoded language codes. This obviously won't work in any other locale. For instance generated RTF on my system is ""{\rtf1\ansi\ansicpg1252\deff0\nouicompat\deftab360{\fonttbl{\f0\fswiss\fcharset0 Arial;}{\f1\fswiss\fcharset238{*\fname Arial;}Arial CE;}}
{*\generator Riched20 14.0.4750.1000;}{*\mmathPr\mwrapIndent1440}\viewkind4\uc1
\pard\f0\fs20\lang1033 > -----"

Bellow is my quick solution using the regular expressions for parsing. It is not tested properly and it is purely written. VBA is foreign to me :( I have also hardcoded my solution to the other part of the problem (hardcoded language and charset in the "new" RTF). I don't have the time right now to solve it generically.

Function RegExpMatchOffset(patrn, strng)
Dim regEx, Match, Matches, s

 Set regEx = CreateObject("vbscript.regexp")
 regEx.pattern = patrn
 regEx.IgnoreCase = True
 regEx.Global = False

 Set Matches = regEx.Execute(strng)
 If Matches.count > 0 Then
   RegExpMatchOffset = Matches.Item(0).FirstIndex + Matches.Item(0).Length + 1
Else
   RegExpMatchOffset = 0
End If

End Function

Public Function ColorizeMailItem(MyMailItem As MailItem) As String
[...]
PosHeaderEnd = InStr(rtf, "\uc1\pard\plain\deftab360")

   If (PosHeaderEnd = 0) Then
        'sTestString = "\uc1\pard\f0\fs20\lang1031"
        'PosHeaderEnd = InStr(rtf, sTestString)
        sTestString = "\\uc\d+\\pard\\f\d+\\fs\d+\\lang\d+\s*"
        PosHeaderEnd = RegExpMatchOffset(sTestString, rtf)
    End If
    If (PosHeaderEnd = 0) Then
        'sTestString = "\viewkind4\uc1\pard\f0\fs20"
        'PosHeaderEnd = InStr(rtf, sTestString)
        sTestString = "\\viewkind\d+\\uc\d+\\pard\\f\d+\\fs\d+\s*"
        PosHeaderEnd = RegExpMatchOffset(sTestString, rtf)
    End If
    If (PosHeaderEnd = 0) Then
        'sTestString = "\pard\f0\fs20\lang1031"
        'PosHeaderEnd = InStr(rtf, sTestString)
        sTestString = "\\pard\\f\d+\\fs\d+\\lang\d+\s*"
        PosHeaderEnd = RegExpMatchOffset(sTestString, rtf)
    End If
    If (PosHeaderEnd = 0) Then
        Debug.Print "error parsing rtf - regexps!"
        ColorizeMailItem = ""
        Exit Function
    End If

    'rtf = mid(rtf, PosHeaderEnd + Len(sTestString))
    rtf = mid(rtf, PosHeaderEnd)

    'The language codes should really be configurable or they should be extracted from the original rtf using regualr expressions!
    rtf = "{\rtf1\ansi\ansicpg1250 \deff0{\fonttbl" & vbCrLf & _
            "{\f0\fswiss\fcharset238 Consolas;}}" & vbCrLf & _
            "{\colortbl\red0\green0\blue0;\red106\green44\blue44;\red44\green106\blue44;\red44\green44\blue106;}" & vbCrLf & _
            rtf

[...]