Since Excel doesn't parse RTF in any way (well, except for import as a file, but that sucks too), I had to convert the RTF field retrieved from the database into plain text so that I could display it for the user.
Following is code that will convert the RTF to plain text.
However, the function makes some assumptions:
- The RTF is normal text, maybe with some font formatting
- No tables, lists or any special RTF structures are supported. They will be converted to plain text with no special formatting. If you need special formatting, you'll have to add appropriate lines of code into the parser...
- The convertor assumes that the code page of the RTF is the same as the code page of the client computer. This is important if you have special (language specific) characters in the RTF itself.
- Also in regard to code page, this convertor will only work on ANSI code pages. This means, it will only convert single-byte characters, not multi byte ones. Since I don't have a multi byte RTF available, I don't know how hard it is to fix this one.
- Also note that I'm no Excel guru, so the code in the macro may be sub-optimal
Private Function hexcode(ss)
If ss = "0" Then
hexcode = 0
ElseIf ss = "1" Then
hexcode = 1
ElseIf ss = "2" Then
hexcode = 2
ElseIf ss = "3" Then
hexcode = 3
ElseIf ss = "4" Then
hexcode = 4
ElseIf ss = "5" Then
hexcode = 5
ElseIf ss = "6" Then
hexcode = 6
ElseIf ss = "7" Then
hexcode = 7
ElseIf ss = "8" Then
hexcode = 8
ElseIf ss = "9" Then
hexcode = 9
ElseIf ss = "a" Or ss = "A" Then
hexcode = 10
ElseIf ss = "b" Or ss = "B" Then
hexcode = 11
ElseIf ss = "c" Or ss = "C" Then
hexcode = 12
ElseIf ss = "d" Or ss = "D" Then
hexcode = 13
ElseIf ss = "e" Or ss = "E" Then
hexcode = 14
ElseIf ss = "f" Or ss = "F" Then
hexcode = 15
Else
hexcode = 0
End If
End Function
Private Function RTF2TXT(ss)
While (Right(ss, 1) = Chr(10) Or Right(ss, 1) = Chr(13) Or Right(ss, 1) = " " Or Right(ss, 1) = "}")
ss = Left(ss, Len(ss) - 1)
Wend
If (Len(ss) >= 1) Then
ss = Right(ss, Len(ss) - 1)
End If
iPos = 1
sResult = ""
While (Len(ss) > 0)
If (Mid(ss, iPos, 1) = "\") Then
If (Mid(ss, iPos + 1, 3) = "tab") Then
sResult = sResult + Chr(9)
iPos = iPos + 4
ElseIf (Mid(ss, iPos + 1, 3) = "par") And (Mid(ss, iPos + 1, 4) <> "pard") Then
sResult = sResult + Chr(10) 'Chr(13) + chr(10) seems to not work, #13 is displayed as a square char
iPos = iPos + 4
ElseIf (Mid(ss, iPos + 1, 1) = "'") Then
sResult = sResult + Chr(hexcode(Mid(ss, iPos + 2, 1)) * 16 + hexcode(Mid(ss, iPos + 3, 1)))
iPos = iPos + 4
Else
iPos = iPos + 1
While Mid(ss, iPos, 1) <> "\" And Mid(ss, iPos, 1) <> "{" And Mid(ss, iPos, 1) <> Chr(13) And Mid(ss, iPos, 1) <> Chr(10) And Mid(ss, iPos, 1) <> " "
iPos = iPos + 1
Wend
If Mid(ss, iPos, 1) = " " Then
iPos = iPos + 1
End If
End If
ElseIf (Mid(ss, iPos, 1) = "{") Then
iLevel = 1
iPos = iPos + 1
While iLevel > 0
If Mid(ss, iPos, 1) = "{" Then
iLevel = iLevel + 1
ElseIf Mid(ss, iPos, 1) = "}" Then
iLevel = iLevel - 1
End If
iPos = iPos + 1
Wend
ElseIf (Mid(ss, iPos, 1) = Chr(10) Or Mid(ss, iPos, 1) = Chr(13)) Then
iPos = iPos + 1
Else
sResult = sResult + Mid(ss, 1, 1)
iPos = iPos + 1
End If
If iPos = Len(ss) Then
ss = ""
Else
ss = Mid(ss, iPos)
End If
iPos = 1
Wend
While (Right(sResult, 1) = Chr(10) Or Right(sResult, 1) = Chr(13) Or Right(sResult, 1) = " ")
sResult = Left(sResult, Len(sResult) - 1)
Wend
RTF2TXT = sResult
End Function
Hope it helps anyone. I couldn't find anything like this function after searching for days.