How can I convert the content of a ritchTextBox to HTML?

[MrPolite]

Is it possible? let's say the text is colorized in my richTextBox, and it has bold, italic and all those kind of stuff in it. How can I convert it to HTML or, lets ms-word's file?

[rjlohan]

It would be a matter of going through all the text, and replacing certain properties with HTML tags. Say you found a line of text that was bold, you would insert <B> and </B> tags around it.

It would take a little time to write the loops for it, but it shouldn't be too hard.

[gdebacker]

I got this original routine from some where and I don't remember. I made so many changes to it that it is an almost completely different routine now, but I should credit some anonymous author who wrote the initial code but I don't know who it is. Anyway here it is...

I use it for email so the subject becomes the title of the page. You call like this. The LockWindowUpdate call prevents you from seeing the cursor scroll.

Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
 
Call LockWindowUpdate(RichText1.hWnd)
sTemp = RichToHTML(RichText1, sSubject, 0, Len(RichText1.Text))
Call LockWindowUpdate(0)

Public Function RichToHTML(rtbRichTextBox As RichTextLib.RichTextBox, sSubject As String, lngStartPosition As Long, lngEndPosition As Long) As String
    
    Dim blnBold As Boolean, blnUnderline As Boolean, blnStrikeThru As Boolean
    Dim blnItalic As Boolean, strLastFont As String, lngLastFontColor As Long
    Dim lngBlue As Long, lngCurText As Long, strHex As String, intLastAlignment As Integer
    Dim bInBullet As Boolean, strHTML As String
    
    Const AlignLeft = 0, AlignRight = 1, AlignCenter = 2
            
    lngLastFontColor& = -1 'no color
    
    strHTML = "<div>"
    
    For lngCurText& = lngStartPosition& To lngEndPosition&
        rtbRichTextBox.SelStart = lngCurText&
        rtbRichTextBox.SelLength = 1
        
 
        If (Not bInBullet) And (Len(rtbRichTextBox.SelText) = 0) Or (intLastAlignment <> rtbRichTextBox.SelAlignment) Then
            intLastAlignment = rtbRichTextBox.SelAlignment
            Select Case rtbRichTextBox.SelAlignment
               Case AlignLeft: strHTML = strHTML & "</div><div align=left>"
               Case AlignRight: strHTML = strHTML & "</div><div align=right>"
               Case AlignCenter: strHTML = strHTML & "</div><div align=center>"
               Case Else: strHTML = strHTML & "</div><div align=left>"
            End Select
            
        End If
        
        If blnBold <> rtbRichTextBox.SelBold Then
            If rtbRichTextBox.SelBold = True Then
                strHTML$ = strHTML$ & "<b>"
            Else
                strHTML$ = strHTML$ & "</b>"
            End If
            blnBold = rtbRichTextBox.SelBold
        End If
 
        If blnUnderline <> rtbRichTextBox.SelUnderline Then
            If rtbRichTextBox.SelUnderline = True Then
              strHTML = strHTML & "<u>"
            Else
              strHTML = strHTML & "</u>"
            End If
            blnUnderline = rtbRichTextBox.SelUnderline
        End If
        
        If blnItalic <> rtbRichTextBox.SelItalic Then
            If rtbRichTextBox.SelItalic = True Then
              strHTML = strHTML & "<i>"
            Else
              strHTML = strHTML & "</i>"
            End If
            blnItalic = rtbRichTextBox.SelItalic
        End If
        
        If blnStrikeThru <> rtbRichTextBox.SelStrikeThru Then
            If rtbRichTextBox.SelStrikeThru = True Then
                strHTML = strHTML & "<s>"
            Else
                strHTML = strHTML & "</s>"
            End If
            blnStrikeThru = rtbRichTextBox.SelStrikeThru
        End If
        
        If strLastFont$ <> rtbRichTextBox.SelFontName Then
            strLastFont$ = rtbRichTextBox.SelFontName
            strHTML = strHTML & "<font face=""" & strLastFont$ & """>"
        End If
        
        If lngLastFontColor& <> rtbRichTextBox.SelColor Then
            lngLastFontColor& = rtbRichTextBox.SelColor
            
            ''Get hexidecimal value of color
            strHex$ = Hex$(rtbRichTextBox.SelColor)
            strHex$ = String$(6 - Len(strHex$), "0") & strHex$
            strHex$ = Right$(strHex$, 2) & Mid$(strHex$, 3, 2) & Left$(strHex$, 2)
            
            strHTML = strHTML & "<font color=#" & strHex$ & ">"
        End If
        
                
        If bInBullet And (Len(rtbRichTextBox.SelText) = 0) Then
            strHTML = strHTML & "</li><li>"
        End If
        
        If Right$(strHTML, 13) = "<li></li><li>" Then strHTML = Left$(strHTML, Len(strHTML) - 9)
        
        If bInBullet <> rtbRichTextBox.SelBullet Then
            If rtbRichTextBox.SelBullet = True Then
                strHTML = strHTML & "<ul><li>"
            Else
                If Right$(strHTML, 9) = "</li><li>" Then strHTML = Left$(strHTML, Len(strHTML) - 9)
                strHTML = strHTML & "</li></ul>"
            End If
            bInBullet = rtbRichTextBox.SelBullet
        End If
        
        strHTML = strHTML + rtbRichTextBox.SelText
    
    Next
    
    If Right$(strHTML, 14) = "<div align=left>" Then strHTML = Left$(strHTML, Len(strHTML) - 16)
    If Right$(strHTML, 15) = "<div align=right>" Then strHTML = Left$(strHTML, Len(strHTML) - 17)
    If Right$(strHTML, 16) = "<div align=center>" Then strHTML = Left$(strHTML, Len(strHTML) - 18)
    If Left$(strHTML, 4) = "</div>" Then strHTML = Right$(strHTML, Len(strHTML) - 4)
    
    strHTML = Replace(strHTML, "<div></div>", "<br>")
    strHTML = Replace(strHTML, "<div align=left></div><div align=left></div>", "<br>")
    strHTML = Replace(strHTML, "<div align=right></div><div align=right></div>", "<br>")
    strHTML = Replace(strHTML, "<div align=center></div><div align=center></div>", "<br>")
    
    If Right$(strHTML, 4) = "<li>" Then strHTML = Left$(strHTML, Len(strHTML) - 4) & "</ul></div>"
    
    strHTML = "<HTML><HEAD><TITLE>" & sSubject & "</TITLE></HEAD><BODY>" & strHTML & "</BODY></HTML>"
    RichToHTML = strHTML
 
End Function