RTFToTXT

Private Sub Command1_Click()
Dim i As Long
Dim j As Long
Dim AllText As String
Dim allcabs As String
Dim Cab As String
Dim letter As String
Dim size As Integer
Dim checkrtf As Integer
Dim formatstring1 As String
Dim formatstring2 As String
Dim textstart As String
Dim alltextlong As Long
Dim rest As Long
RichTextBox1.SelStart = 0 'select all
RichTextBox1.SelLength = Len(RichTextBox1.Text)
RichTextBox1.SelFontName = "Times New Roman"
RichTextBox1.SelFontSize = 11
AllText = RichTextBox1.TextRTF 'save rtftext
textstart = "\pard" 'declaration section in rtf
Alltextlong = Len(RichTextBox1.TextRTF)
RichTextBox1.Text = ""
On Error Goto errhandler:
For i = 1 To alltextlong
If Mid(AllText, i, Len(textstart)) = textstart Then 'search "\pard"
rest = i + Len(textstart) ' rest of rtf text
allcabs = Left(AllText, i - Len(textstart))
'search format string /plain/....

formatstring1 = Mid(AllText, rest, 14)
size = Val(Right(formatstring1, 2)) + 8
formatstring2 = Left(formatstring1, 12) & size
'up to here rtf format header

'allcabs fills in the rtf format up to the "\" of "\plain"

For j = rest To alltextlong
letter = Mid(AllText, j, 1)
Code = (Asc(letter))
If Asc(letter) > 64 Then
If Asc(letter) < 91 Then 'if Cab then increase size
letter = formatstring2 & " " & letter & formatstring1
End If
End If
If Asc(letter) > 96 Then
If Asc(letter) < 123 Then
letter = Chr(Asc(letter) - 32)
End If
End If
allcabs = allcabs + letter '
Next j
RichTextBox1.TextRTF = allcabs
RichTextBox1.SetFocus
letter = ""
Exit Sub
End If
Next i
errhandler:
RichTextBox1.TextRTF = AllText
End Sub

Private Sub Form_Load()
Command1.Caption = "Small Cabs"
With RichTextBox1
.Left = 0
.Width = Form1.Width - 100
.RightMargin = Form1.Width - 400
End With
End Sub
Assumes:
Create a form, a button and a rtf box.

Side Effects:
works only one time. Then the lowercase are no more

Inputs to perform this task are welcome.