Convert RTF to Plain Text (ASCII)

[Dennis W. Bulgrien]

Does somebody have a code snippet to strip Rich Text Format down to plain text?

 

[Dennis W. Bulgrien]

'Desc: Converts Rich Text Format value sRTF to plain text (returned).
'Notes:
' * does not support binary data
' * escaped sequences (prefixed with backslash) supported: \ { }
' e.g. "\fonttbl{\f0}" yeilds ""; "\\fonttbl\{\f0\}" yeilds "\fonttbl{}"
' * ignores text not in level one braces
' e.g. "{a{b}\{c\}}{d}" yields "a{c}d"
' 2003/11/05 Dennis W. Bulgrien, VertexRSI
Function CRTF2Text(ByVal sRTF As String) As String
Dim i As Integer ' index into sRTF
Dim c As String * 1 ' character at i
Dim iLen As Integer ' length of sRTF
Dim iBrace As Integer ' bracing level (i.e. number of unterminated {'s )
Dim sText As String ' stripped sRTF
Dim tfText As Boolean ' True if c is part of Text

iLen = Len(sRTF)
For i = 1 To iLen
c = Mid$(sRTF, i, 1)
If c = "}" Then
iBrace = iBrace - 1
ElseIf c = "{" Then
iBrace = iBrace + 1
ElseIf iBrace = 1 Then ' Ignore all chars outside of level one
tfText = Not c Like "[" & vbCr & vbLf & "]" ' Default for non-\, skip
line ending
If c = "\" Then
If Mid$(sRTF, i, 5) Like "\par[\ " & vbCr & "]" Then
c = vbCr ' Convert \par to CR
i = i + 3 ' Skip "par"
If Mid$(sRTF, i, 1) <> "\" Then i = i + 1
' Skip space or CR if following \par
Else
i = i + 1
c = Mid$(sRTF, i, 1)
tfText = c Like "[\{}]" ' Was \ an escape for literal?
If Not tfText Then ' Skip \-command
Do Until i = iLen Or c Like "[\{} " & vbCr & "]"
' space and CR terminate \-command, next
\-command can follow immediately
i = i + 1 ' Skip RTF \-commands
c = Mid$(sRTF, i, 1)
Loop
End If
End If
End If
If tfText Then
sText = sText & c
ElseIf c Like "[\{}]" Then ' discard whitespace terminating
\-command
i = i - 1 ' re-process special terminating char
End If
End If
Next i
CRTF2Text = sText
End Function

 

[Valerio D Arrigo]

I had issues while using the above code so i wrote the following.
If someone finds flaws please post a tip or a corrected Version.

Private Function RTF2Text(ByVal sRTF As String) As String
    Dim Ci As String, Ck As String, RTFcommandSTR As String, PlainText As String
    Dim RTFcommands() As String
    Dim iLen As Integer, iBrace As Integer, i As Integer, k As Integer, j As Integer
 
    iLen = Len(sRTF)
    iBrace = 0
    For i = 1 To iLen
        Ci = Mid$(sRTF, i, 1)

        If Ci = "}" Or Ci = "{" Then
            If Ci = "}" Then iBrace = iBrace - 1
            If Ci = "{" Then iBrace = iBrace + 1
        Else
            If iBrace = 1 Then
                If Ci = "\" Then 'handle RTF Tags
                    For k = i To iLen
                        Ck = Mid$(sRTF, k, 1)
                        If Ck = Chr(10) Or Ck = Chr(13) Or Ck = Chr(32) Then
                            RTFcommandSTR = Mid$(sRTF, i, k - i)
                            RTFcommands = Split(RTFcommandSTR, "\")
                            i = k
                            For j = 0 To UBound(RTFcommands)
                                If RTFcommands(j) = "par" Then PlainText = PlainText & Chr(10)
                            Next j
                            Exit For
                        End If
                    Next k
                Else 'add the Chr to the output
                    PlainText = PlainText & Ci
                End If
            End If
        End If
    Next i
 
    RTF2Text = PlainText
End Function