RTF 2 HTML converter

Does anyone know where i can get a good RTF to HTML converter, i have got one but lets just say it's not the best in the world, preferably it converts picture that are in the RTF document also

Thanks in advance

Try using Microsoft Word 97 or Word Perfect 8 (or better), both do an ok job.

Code:

---

'declarations
Function RichToHTML(rtbRichTextBox As RichTextLib.RichTextBox, Optional lngStartPosition As Long, Optional 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 strHTML As String, lngColor As Long, lngRed As Long, lngGreen As Long
Dim lngBlue As Long, lngCurText As Long, strHex As String, intLastAlignment As Integer

Const AlignLeft = 0, AlignRight = 1, AlignCenter = 2

'check for lngStartPosition ad lngEndPosition

If IsMissing(lngStartPosition&) Then lngStartPosition& = 0
If IsMissing(lngEndPosition&) Then lngEndPosition& = Len(rtbRichTextBox.Text)

lngLastFontColor& = -1 'no color

  For lngCurText& = lngStartPosition& To lngEndPosition&
      rtbRichTextBox.SelStart = lngCurText&
      rtbRichTextBox.SelLength = 1
 
          If intLastAlignment% <> rtbRichTextBox.SelAlignment Then
            intLastAlignment% = rtbRichTextBox.SelAlignment
             
                Select Case rtbRichTextBox.SelAlignment
                  Case AlignLeft: strHTML$ = strHTML$ & "<p align=left>"
                  Case AlignRight: strHTML$ = strHTML$ & "<p align=right>"
                  Case AlignCenter: strHTML$ = strHTML$ & "<p align=center>"
                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
 
    strHTML$ = strHTML$ + rtbRichTextBox.SelText

  Next lngCurText&

RichToHTML = strHTML$

End Function



Sub HTMLToRich(strHTML As String, rtbRichTextBox As RichTextLib.RichTextBox)
Dim blnBold As Boolean, blnUnderline As Boolean, blnStrikeThru As Boolean
Dim blnItalic As Boolean, strLastFont As String, lngLastFontColor As Long, lngLastFontSize As Long
Dim lngChar As Long, strTag As String, lngSpot As Long, strChar As String
Dim lngAlign As Long, strBuf As String, strBuf2 As String, lngBuf As Long, strBuf3 As String

Const AlignLeft = 0, AlignRight = 1, AlignCenter = 2

'set default values
strLastFont$ = rtbRichTextBox.Font.Name
lngLastFontColor& = -1

'clear richtextbox
rtbRichTextBox.Text = ""


  'Loop through string. If finds an HTML string
  For lngChar& = 1 To Len(strHTML$)
      strChar$ = Mid$(strHTML$, lngChar&, 1)
     
        If strChar$ = "<" Then
          lngSpot& = InStr(lngChar& + 1, strHTML$, ">")
              If lngSpot& Then
             
                strTag$ = LCase$(Mid$(strHTML$, lngChar& + 1, lngSpot& - lngChar& - 1))
               
                  If strTag$ = "b" Then
                      blnBold = True
                  ElseIf strTag$ = "/b" Then
                      blnBold = False
                  ElseIf strTag$ = "u" Then
                      blnUnderline = True
                  ElseIf strTag$ = "/u" Then
                      blnUnderline = False
                  ElseIf strTag$ = "i" Then
                      blnItalic = True
                  ElseIf strTag$ = "/i" Then
                      blnItalic = False
                  ElseIf strTag$ = "s" Then
                      blnStrikeThru = True
                  ElseIf strTag$ = "/s" Then
                      blnStrikeThru = False
                  ElseIf Left$(strTag$, 8) = "p align=" Then
                      strBuf$ = Right$(strTag$, Len(strTag$) - 8)
                      strBuf3$ = ""
                     
                        For lngBuf& = 1 To Len(strBuf$)
                              strBuf2$ = Mid$(strBuf$, lngBuf&, 1)
                              If strBuf2$ <> """" Then strBuf3$ = strBuf3$ & strBuf2$
                        Next lngBuf&
                       
                        Select Case strBuf3$
                            Case "left":  lngAlign& = AlignLeft
                            Case "right":  lngAlign& = AlignRight
                            Case "center": lngAlign& = AlignCenter
                        End Select
                       
                  ElseIf Left$(strTag$, 5) = "font " Then
                      strBuf$ = Right$(strTag$, Len(strTag$) - 5)
                       
                        Select Case Left$(strBuf$, InStr(strBuf$, "=") - 1)
                           
                            Case "color":
                              strBuf$ = Right$(strBuf$, Len(strBuf$) - InStr(strBuf$, "="))
                              strBuf3$ = ""
                                  For lngBuf& = 1 To Len(strBuf$)
                                    strBuf2$ = Mid$(strBuf$, lngBuf&, 1)
                                    If strBuf2$ <> """" And strBuf2$ <> "#" Then strBuf3$ = strBuf3$ & strBuf2$
                                  Next lngBuf&
                              lngLastFontColor& = HexToDecimal(strBuf3$)
                           
                            Case "face":
                              strBuf$ = Right$(strBuf$, Len(strBuf$) - InStr(strBuf$, "="))
                              strBuf3$ = ""
                                  For lngBuf& = 1 To Len(strBuf$)
                                    strBuf2$ = Mid$(strBuf$, lngBuf&, 1)
                                    If strBuf2$ <> """" Then strBuf3$ = strBuf3$ & strBuf2$
                                  Next lngBuf&
                              strLastFont$ = strBuf3$
                           
                            Case "size":
                              strBuf$ = Right$(strBuf$, Len(strBuf$) - InStr(strBuf$, "="))
                              strBuf3$ = ""
                                  For lngBuf& = 1 To Len(strBuf$)
                                    strBuf2$ = Mid$(strBuf$, lngBuf&, 1)
                                    If strBuf2$ <> """" Then strBuf3$ = strBuf3$ & strBuf2$
                                  Next lngBuf&
                                 
                                  Select Case strBuf3$
                                      Case "1": lngLastFontSize& = 4
                                      Case "2": lngLastFontSize& = 8
                                      Case "3": lngLastFontSize& = 10
                                      Case "4": lngLastFontSize& = 14
                                      Case "5": lngLastFontSize& = 18
                                      Case "6": lngLastFontSize& = 20
                                      Case "7": lngLastFontSize& = 72
                                  End Select
                                 
                        End Select
                  End If
                 
                'skip over html tag
                lngChar& = lngSpot&
              End If 'for: If lngSpot& Then
        Else
          'set character with curretn artributes.
          rtbRichTextBox.SelStart = Len(rtbRichTextBox.Text)
          rtbRichTextBox.SelLength = 0
          rtbRichTextBox.SelText = strChar$
          rtbRichTextBox.SelStart = Len(rtbRichTextBox.Text) - 1
          rtbRichTextBox.SelLength = 1
          rtbRichTextBox.SelBold = blnBold
          rtbRichTextBox.SelUnderline = blnUnderline
          rtbRichTextBox.SelItalic = blnItalic
          rtbRichTextBox.SelStrikeThru = blnStrikeThru
          rtbRichTextBox.SelFontName = strLastFont$
          rtbRichTextBox.SelFontSize = lngLastFontSize&
          rtbRichTextBox.SelAlignment = lngAlign&
          rtbRichTextBox.SelColor = lngLastFontColor&
        End If 'for: If rtbRichTextBox.SelText = "<" Then
   

     
    Next lngChar&


End Sub

Function HexToDecimal(ByVal strHex As String) As Long

'This function is required by the function 'HTMLToRich'

'this function converts any hexidecimal color value
'(e.g. "0000FF" = Blue) to decimal color value.

Dim lngDecimal As Long, strCharHex As String, lngColor As Long
Dim lngChar As Long

If Left$(strHex$, 1) = "#" Then strHex$ = Right$(strHex$, 6)
 
strHex$ = Right$(strHex$, 2) & Mid$(strHex$, 3, 2) & Left$(strHex$, 2)

  For lngChar& = Len(strHex$) To 1 Step -1
    strCharHex$ = Mid$(UCase$(strHex$), lngChar&, 1)
   
      Select Case strCharHex$
          Case 0 To 9
            lngDecimal& = CLng(strCharHex$)
          Case Else 'A,B,C,D,E,F
            lngDecimal& = CLng(Chr$((Asc(strCharHex$) - 17))) + 10
      End Select
     
    lngColor& = lngColor& + lngDecimal& * 16 ^ (Len(strHex$) - lngChar&)
  Next lngChar&
 
HexToDecimal = lngColor&

End Function


'FEW,  THATS DONE, NOW FOR THE ACTUAL CODING....

Private Sub cmdConvertToHTML_Click()
  txtHTML.Text = RichToHTML(rtbRichText, 0&, Len(rtbRichText.Text))
End Sub

Private Sub cmdConvertToRichText_Click()
  Call HTMLToRich(txtHTML.Text, rtbRichText)
End Sub

Private Sub Form_Load()

  'set the text in rtbRichTextBox
 
  With rtbRichText
    .Text = "Click on the 'convert' button to convert this richtext to HTML."
    .SelStart = 0
    .SelLength = Len(.Text)
    .SelFontName = "Arial"
    .SelFontSize = 10
    .SelAlignment = rtfCenter
    .SelStart = InStr(.Text, "convert") - 1
    .SelLength = Len("convert")
    .SelFontName = "Courier New"
    .SelColor = vbBlue
    .SelStart = InStr(.Text, "HTML") - 1
    .SelLength = 4
    .SelFontName = "Courier New"
    .SelUnderline = True
    .SelStart = .SelStart + 1
    .SelLength = 1
    .SelColor = vbRed
    .SelStart = .SelStart + 1
    .SelLength = 1
    .SelColor = vbBlue
    .SelStart = .SelStart + 1
    .SelLength = 1
    .SelColor = vbGreen
    .SelStart = 0
    .SelLength = 0
  End With


End Sub

---

Okay this is what you need on the form:
a textbox named txtHTML
a richtextbox named rtbRichText
a button named cmdConvertToHTML
and the last button named cmdConvertToRichText


hope this is what you wanted

I use this codes. Thanks very much. But how can I add a link to a word and how can the converter convert the link code. Please Help me.

Thanks very much for your help.