Archive

Archive for February, 2012

rtf to html in ms-access

February 26th, 2012 No comments

I needed to convert chunks of RTF formatted text into HTML in microsoft access 2003. I wanted it quick, easy, and free. This blog post is an assembly of information culled from various places on the net. I didn’t invent any of this stuff.

(Access 2010 supposedly supports RTF memo field types but I doubt it converts to HTML. You might check into it if you’re using that version.)

For Windows 7, you need to get RichTx32.ocx version 6.01.98.16 Dated 3/24/2009 12:52PM

This particular version seems to be the latest one to actually work. Prior versions are flagged by the activex killbits thingy to prevent older, presumably buggier versions from being used.

If 64 bit OS:
Put the file into C:\Windows\SysWOW64
then register it
Regsvr32 C:\Windows\SysWOW64\richtx32.ocx

If 32 bit OS:
Put it into C:\Windows\System32
then register it
Regsvr32 C:\Windows\System32\richtx32.ocx

In Microsoft Access, you need to add the ocx to your project references so you can use it. The picture below shows you how.

If you wish to add the control onto a form or report for whatever reason, it will help to know that it is called “Microsoft Rich Textbox Control 6.0 (SP6)”

Now you’re good to go for using it in visual basic. I found this code in a VB FAQ at tek-tips.com.

I changed the code slightly from the original. The original code passed in the rtf object itself. I wanted to pass in the actual rtf data and get html back so I could use it directly in a query or as the source of a report’s textbox control. The report “prints” html code which I export as text into a .html file, perhaps the subject of another blog some day.


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

' While it may not be efficient to create and destroy the RTF object on every call, it serves my needs.
Public Function RTFtoHTML(rtfdata As String) As String

  Dim mRGB(2) As Byte
  Const html_Break = vbCrLf & "<BR>" & vbCrLf
  
  Dim RTFBox As RichTextBox
  Set RTFBox = New RichTextBox
    
  RTFBox.SelStart = 0
  RTFBox.SelLength = 0
  RTFBox.SelText = rtfdata
  
  RTFBox.SelStart = 0
  RTFBox.SelLength = Len(rtfdata)

  html$ = ""
  BullStyle$ = "{ margin-left: 15px; margin-bottom: 0px; margin-top: 0px; }"
  curr_Align = -1
  With RTFBox
    txt$ = .text
    For A& = 0 To Len(txt$)
      .SelStart = A&
      
      If (A& <> 0) Then
        If (Mid$(txt$, A&, 2) = "•" & vbTab) Then
          html$ = html$ & "<UL class='bull'><LI>"
          curr_Bullet = True
          A& = A& + 1
          GoTo s_Skip
        End If
      End If
      If (curr_FontFace <> .SelFontName) Or (curr_FontSize <> .SelFontSize) Or (curr_ForeColour <> .SelColor) Then
        CC& = .SelColor
        CopyMemory mRGB(0), CC&, Len(CC&)
        GC$ = Right$("0" & Hex$(mRGB(0)), 2) & Right$("0" & Hex$(mRGB(1)), 2) & Right$("0" & Hex$(mRGB(2)), 2)
        html$ = html$ & IIf(A& = 0, "", "</span>") & vbCrLf & "<span style='"
        Lump$ = "{ font-family: " & .SelFontName & "; font-size: " & .SelFontSize & "pt; color: #" & GC$ & "; }"
        If (A& = 0) Then MainStyle$ = Lump$
        html$ = html$ & Lump$ & "'>"
        curr_FontFace = .SelFontName
        curr_FontSize = .SelFontSize
        curr_ForeColour = .SelColor
      End If
      If (curr_Bold <> .SelBold) Then
        html$ = html$ & IIf(.SelBold, "<B>", "</B>")
        curr_Bold = .SelBold
      End If
      If (curr_Under <> .SelUnderline) Then
        html$ = html$ & IIf(.SelUnderline, "<U>", "</U>")
        curr_Under = .SelUnderline
      End If
      If (curr_Italic <> .SelItalic) Then
        html$ = html$ & IIf(.SelItalic, "<I>", "</I>")
        curr_Italic = .SelItalic
      End If
      If (curr_Align <> .SelAlignment) Then
        html$ = html$ & IIf((A& <> 0) And (Ended = False), "</P>", "") & "<P style='{ margin-top: 0px; margin-bottom: 0px; }' Align='" & Choose(.SelAlignment + 1, "left", "right", "center") & "'>"
        Ended = False
        curr_Align = .SelAlignment
      End If
      If (A& <> 0) Then
        If (Mid$(txt$, A&, 2) = vbCrLf) Then
          If (curr_Bullet = True) Then
            html$ = html$ & "</UL>"
            Ended = True
            curr_Bullet = False
           Else
            html$ = html$ & html_Break
          End If
          A& = A& + 1
         ElseIf (Mid$(txt$, A&, 1) = "<") Then
          html$ = html$ & "&lt;"
         ElseIf (Mid$(txt$, A&, 1) = ">") Then
          html$ = html$ & "&gt;"
         Else
          html$ = html$ & Mid$(txt$, A&, 1)
        End If
      End If
s_Skip:
    Next A&
  End With
  
  html$ = Replace$(html$, html_Break & "</P>", "</P>")
  html$ = Replace$(html$, "<span style='" & MainStyle$ & "'>", "<span class='core'>")
  html$ = html$ & vbCrLf _
                & "<style>" & vbCrLf _
                & "span.core " & MainStyle$ & vbCrLf _
                & "ul.bull " & BullStyle$ & vbCrLf _
                & "</style>" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "<HR>" & vbCrLf
  
  RTFtoHTML = html$

End Function