home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / himetr1r / modrtfto.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-14  |  23.9 KB  |  480 lines
  1. Attribute VB_Name = "modRtfToHTML"
  2. '----------------------------------------
  3. '- Name: Sam Huggill
  4. '- Email: sam@vbsquare.com
  5. '- Web: http://www.vbsquare.com/
  6. '- Company: Lighthouse Internet Solutions
  7. '- Date/Time: 14/08/99 11:29:08
  8. '----------------------------------------
  9. '- Notes:   Converts RTF Code to HTML Code
  10. '
  11. '----------------------------------------
  12.  
  13. Option Explicit
  14.  
  15. Function RTF2HTML(strRTF As String, Optional strOptions As String, Optional strHeader As String, Optional strFooter As String) As String
  16.     'Version 2.9
  17.  
  18.     'The current version of this function is available at
  19.     'http://www2.bitstream.net/~bradyh/downloads/rtf2html.zip
  20.  
  21.     'More information can be found at
  22.     'http://www2.bitstream.net/~bradyh/downloads/rtf2htmlrm.html
  23.  
  24.     'Converts Rich Text encoded text to HTML format
  25.     'if you find some text that this function doesn't
  26.     'convert properly please email the text to
  27.     'bradyh@bitstream.net
  28.  
  29.     'Options:
  30.     '+H              add an HTML header and footer
  31.     '+G              add a generator Metatag
  32.     '+T="MyTitle"    add a title (only works if +H is used)
  33.     Dim strHTML As String
  34.     Dim l As Long
  35.     Dim lTmp As Long
  36.     Dim lTmp2 As Long
  37.     Dim lTmp3 As Long
  38.     Dim lRTFLen As Long
  39.     Dim lBOS As Long                 'beginning of section
  40.     Dim lEOS As Long                 'end of section
  41.     Dim strTmp As String
  42.     Dim strTmp2 As String
  43.     Dim strEOS As String             'string to be added to end of section
  44.     Dim strBOS As String             'string to be added to beginning of section
  45.     Dim strEOP As String             'string to be added to end of paragraph
  46.     Dim strBOL As String             'string to be added to the begining of each new line
  47.     Dim strEOL As String             'string to be added to the end of each new line
  48.     Dim strEOLL As String            'string to be added to the end of previous line
  49.     Dim strCurFont As String         'current font code eg: "f3"
  50.     Dim strCurFontSize As String     'current font size eg: "fs20"
  51.     Dim strCurColor As String        'current font color eg: "cf2"
  52.     Dim strFontFace As String        'Font face for current font
  53.     Dim strFontColor As String       'Font color for current font
  54.     Dim lFontSize As Integer         'Font size for current font
  55.     Const gHellFrozenOver = False    'always false
  56.     Dim gSkip As Boolean             'skip to next word/command
  57.     Dim strCodes As String           'codes for ascii to HTML char conversion
  58.     Dim strCurLine As String         'temp storage for text for current line before being added to strHTML
  59.     Dim strColorTable() As String    'table of colors
  60.     Dim lColors As Long              '# of colors
  61.     Dim strFontTable() As String     'table of fonts
  62.     Dim lFonts As Long               '# of fonts
  63.     Dim strFontCodes As String       'list of font code modifiers
  64.     Dim gSeekingText As Boolean      'True if we have to hit text before inserting a </FONT>
  65.     Dim gText As Boolean             'true if there is text (as opposed to a control code) in strTmp
  66.     Dim strAlign As String           '"center" or "right"
  67.     Dim gAlign As Boolean            'if current text is aligned
  68.     Dim strGen As String             'Temp store for Generator Meta Tag if requested
  69.     Dim strTitle As String           'Temp store for Title if requested
  70.  
  71.     'setup HTML codes
  72.     strCodes = "   {00}©  {a9}´ {b4}« {ab}» {bb}¡ {a1}¿{bf}À{c0}à{e0}Á{c1}"
  73.     strCodes = strCodes & "á{e1} {c2}â {e2}Ã{c3}ã{e3}Ä  {c4}ä  {e4}Å {c5}å {e5}Æ {c6}"
  74.     strCodes = strCodes & "æ {e6}Ç{c7}ç{e7}Р  {d0}ð   {f0}È{c8}è{e8}É{c9}é{e9}Ê {ca}"
  75.     strCodes = strCodes & "ê {ea}Ë  {cb}ë  {eb}Ì{cc}ì{ec}Í{cd}í{ed}Π{ce}î {ee}Ï  {cf}"
  76.     strCodes = strCodes & "ï  {ef}Ñ{d1}ñ{f1}Ò{d2}ò{f2}Ó{d3}ó{f3}Ô {d4}ô {f4}Õ{d5}"
  77.     strCodes = strCodes & "õ{f5}Ö  {d6}ö  {f6}Ø{d8}ø{f8}Ù{d9}ù{f9}Ú{da}ú{fa}Û {db}"
  78.     strCodes = strCodes & "û {fb}Ü  {dc}ü  {fc}Ý{dd}ý{fd}ÿ  {ff}Þ {de}þ {fe}ß {df}§  {a7}"
  79.     strCodes = strCodes & "¶  {b6}µ {b5}¦{a6}±{b1}·{b7}¨   {a8}¸ {b8}ª  {aa}º  {ba}¬   {ac}"
  80.     strCodes = strCodes & "­   {ad}¯  {af}°   {b0}¹  {b9}²  {b2}³  {b3}¼{bc}½{bd}¾{be}× {d7}"
  81.     strCodes = strCodes & "÷{f7}¢  {a2}£ {a3}¤{a4}¥   {a5}...     {85}"
  82.  
  83.     'setup color table
  84.     lColors = 0
  85.     ReDim strColorTable(0)
  86.     lBOS = InStr(strRTF, "\colortbl")
  87.     If lBOS <> 0 Then
  88.         lEOS = InStr(lBOS, strRTF, ";}")
  89.         If lEOS <> 0 Then
  90.             lBOS = InStr(lBOS, strRTF, "\red")
  91.             While ((lBOS <= lEOS) And (lBOS <> 0))
  92.                 ReDim Preserve strColorTable(lColors)
  93.                 strTmp = Trim(Hex(mID(strRTF, lBOS + 4, 1) & IIf(IsNumeric(mID(strRTF, lBOS + 5, 1)), mID(strRTF, lBOS + 5, 1), "") & IIf(IsNumeric(mID(strRTF, lBOS + 6, 1)), mID(strRTF, lBOS + 6, 1), "")))
  94.                 If Len(strTmp) = 1 Then strTmp = "0" & strTmp
  95.                 strColorTable(lColors) = strColorTable(lColors) & strTmp
  96.                 lBOS = InStr(lBOS, strRTF, "\green")
  97.                 strTmp = Trim(Hex(mID(strRTF, lBOS + 6, 1) & IIf(IsNumeric(mID(strRTF, lBOS + 7, 1)), mID(strRTF, lBOS + 7, 1), "") & IIf(IsNumeric(mID(strRTF, lBOS + 8, 1)), mID(strRTF, lBOS + 8, 1), "")))
  98.                 If Len(strTmp) = 1 Then strTmp = "0" & strTmp
  99.                 strColorTable(lColors) = strColorTable(lColors) & strTmp
  100.                 lBOS = InStr(lBOS, strRTF, "\blue")
  101.                 strTmp = Trim(Hex(mID(strRTF, lBOS + 5, 1) & IIf(IsNumeric(mID(strRTF, lBOS + 6, 1)), mID(strRTF, lBOS + 6, 1), "") & IIf(IsNumeric(mID(strRTF, lBOS + 7, 1)), mID(strRTF, lBOS + 7, 1), "")))
  102.                 If Len(strTmp) = 1 Then strTmp = "0" & strTmp
  103.                 strColorTable(lColors) = strColorTable(lColors) & strTmp
  104.                 lBOS = InStr(lBOS, strRTF, "\red")
  105.                 lColors = lColors + 1
  106.             Wend
  107.         End If
  108.     End If
  109.  
  110.     'setup font table
  111.     lFonts = 0
  112.     ReDim strFontTable(0)
  113.     lBOS = InStr(strRTF, "\fonttbl")
  114.     If lBOS <> 0 Then
  115.         lEOS = InStr(lBOS, strRTF, ";}}")
  116.         If lEOS <> 0 Then
  117.             lBOS = InStr(lBOS, strRTF, "\f0")
  118.             While ((lBOS <= lEOS) And (lBOS <> 0))
  119.                 ReDim Preserve strFontTable(lFonts)
  120.                 While ((mID(strRTF, lBOS, 1) <> " ") And (lBOS <= lEOS))
  121.                     lBOS = lBOS + 1
  122.                 Wend
  123.                 lBOS = lBOS + 1
  124.                 strTmp = mID(strRTF, lBOS, InStr(lBOS, strRTF, ";") - lBOS)
  125.                 strFontTable(lFonts) = strFontTable(lFonts) & strTmp
  126.                 lBOS = InStr(lBOS, strRTF, "\f" & (lFonts + 1))
  127.                 lFonts = lFonts + 1
  128.             Wend
  129.         End If
  130.     End If
  131.  
  132.     strHTML = ""
  133.     lRTFLen = Len(strRTF)
  134.     'seek first line with text on it
  135.     lBOS = InStr(strRTF, vbCrLf & "\deflang")
  136.     If lBOS = 0 Then GoTo finally Else lBOS = lBOS + 2
  137.     lEOS = InStr(lBOS, strRTF, vbCrLf & "\par")
  138.     If lEOS = 0 Then GoTo finally
  139.  
  140.     While Not gHellFrozenOver
  141.         strTmp = mID(strRTF, lBOS, lEOS - lBOS)
  142.         l = lBOS
  143.         While l <= lEOS
  144.             strTmp = mID(strRTF, l, 1)
  145.             Select Case strTmp
  146.                 Case "{"
  147.                     l = l + 1
  148.                 Case "}"
  149.                     strCurLine = strCurLine & strEOS
  150.                     strEOS = ""
  151.                     l = l + 1
  152.                 Case "\"    'special code
  153.                     l = l + 1
  154.                     strTmp = mID(strRTF, l, 1)
  155.                     Select Case strTmp
  156.                         Case "b"
  157.                             If ((mID(strRTF, l + 1, 1) = " ") Or (mID(strRTF, l + 1, 1) = "\")) Then
  158.                                 'b = bold
  159.                                 strCurLine = strCurLine & "<B>"
  160.                                 strEOS = "</B>" & strEOS
  161.                                 If (mID(strRTF, l + 1, 1) = " ") Then l = l + 1
  162.                             ElseIf (mID(strRTF, l, 7) = "bullet ") Then
  163.                                 strTmp = "ò"     'bullet
  164.                                 l = l + 6
  165.                                 gText = True
  166.                             Else
  167.                                 gSkip = True
  168.                             End If
  169.                         Case "c"
  170.                             If ((mID(strRTF, l, 2) = "cf") And (IsNumeric(mID(strRTF, l + 2, 1)))) Then
  171.                                 'cf = color font
  172.                                 lTmp = Val(mID(strRTF, l + 2, 5))
  173.                                 If lTmp <= UBound(strColorTable) Then
  174.                                     strCurColor = "cf" & lTmp
  175.                                     strFontColor = "#" & strColorTable(lTmp)
  176.                                     gSeekingText = True
  177.                                 End If
  178.                                 'move "cursor" position to next rtf code
  179.                                 lTmp = l
  180.                                 While ((mID(strRTF, lTmp, 1) <> " ") And (mID(strRTF, lTmp, 1) <> "\"))
  181.                                     lTmp = lTmp + 1
  182.                                 Wend
  183.                                 If (mID(strRTF, lTmp, 1) = " ") Then
  184.                                     l = lTmp
  185.                                 Else
  186.                                     l = lTmp - 1
  187.                                 End If
  188.                             Else
  189.                                 gSkip = True
  190.                             End If
  191.                         Case "e"
  192.                             If (mID(strRTF, l, 7) = "emdash ") Then
  193.                                 strTmp = "ù"
  194.                                 l = l + 6
  195.                                 gText = True
  196.                             Else
  197.                                 gSkip = True
  198.                             End If
  199.                         Case "f"
  200.                             If IsNumeric(mID(strRTF, l + 1, 1)) Then
  201.                                 'f# = font
  202.                                 'first get font number
  203.                                 lTmp = l + 2
  204.                                 strTmp2 = mID(strRTF, l + 1, 1)
  205.                                 While IsNumeric(mID(strRTF, lTmp, 1))
  206.                                     strTmp2 = strTmp2 & mID(strRTF, lTmp2, 1)
  207.                                     lTmp = lTmp + 1
  208.                                 Wend
  209.                                 lTmp = Val(strTmp2)
  210.                                 strCurFont = "f" & lTmp
  211.                                 If ((lTmp <= UBound(strFontTable)) And (strFontTable(lTmp) <> strFontTable(0))) Then
  212.                                     'insert codes if lTmp is a valid font # AND the font is not the default font
  213.                                     strFontFace = strFontTable(lTmp)
  214.                                     gSeekingText = True
  215.                                 End If
  216.                                 'move "cursor" position to next rtf code
  217.                                 lTmp = l
  218.                                 While ((mID(strRTF, lTmp, 1) <> " ") And (mID(strRTF, lTmp, 1) <> "\"))
  219.                                     lTmp = lTmp + 1
  220.                                 Wend
  221.                                 If (mID(strRTF, lTmp, 1) = " ") Then
  222.                                     l = lTmp
  223.                                 Else
  224.                                     l = lTmp - 1
  225.                                 End If
  226.                             ElseIf ((mID(strRTF, l + 1, 1) = "s") And (IsNumeric(mID(strRTF, l + 2, 1)))) Then
  227.                                 'fs# = font size
  228.                                 'first get font size
  229.                                 lTmp = l + 3
  230.                                 strTmp2 = mID(strRTF, l + 2, 1)
  231.                                 While IsNumeric(mID(strRTF, lTmp, 1))
  232.                                     strTmp2 = strTmp2 & mID(strRTF, lTmp, 1)
  233.                                     lTmp = lTmp + 1
  234.                                 Wend
  235.                                 lTmp = Val(strTmp2)
  236.                                 strCurFontSize = "fs" & lTmp
  237.                                 lFontSize = Int((lTmp / 5) - 2)
  238.                                 If lFontSize = 2 Then
  239.                                     strCurFontSize = ""
  240.                                     lFontSize = 0
  241.                                 Else
  242.                                     gSeekingText = True
  243.                                     If lFontSize > 8 Then lFontSize = 8
  244.                                     If lFontSize < 1 Then lFontSize = 1
  245.                                 End If
  246.                                 'move "cursor" position to next rtf code
  247.                                 lTmp = l
  248.                                 While ((mID(strRTF, lTmp, 1) <> " ") And (mID(strRTF, lTmp, 1) <> "\"))
  249.                                     lTmp = lTmp + 1
  250.                                 Wend
  251.                                 If (mID(strRTF, lTmp, 1) = " ") Then
  252.                                     l = lTmp
  253.                                 Else
  254.                                     l = lTmp - 1
  255.                                 End If
  256.                             Else
  257.                                 gSkip = True
  258.                             End If
  259.                         Case "i"
  260.                             If ((mID(strRTF, l + 1, 1) = " ") Or (mID(strRTF, l + 1, 1) = "\")) Then
  261.                                 strCurLine = strCurLine & "<I>"
  262.                                 strEOS = "</I>" & strEOS
  263.                                 If (mID(strRTF, l + 1, 1) = " ") Then l = l + 1
  264.                             Else
  265.                                 gSkip = True
  266.                             End If
  267.                         Case "l"
  268.                             If (mID(strRTF, l, 10) = "ldblquote ") Then
  269.                                 'left doublequote
  270.                                 strTmp = "ô"
  271.                                 l = l + 9
  272.                                 gText = True
  273.                             ElseIf (mID(strRTF, l, 7) = "lquote ") Then
  274.                                 'left quote
  275.                                 strTmp = "æ"
  276.                                 l = l + 6
  277.                                 gText = True
  278.                             Else
  279.                                 gSkip = True
  280.                             End If
  281.                         Case "p"
  282.                             If ((mID(strRTF, l, 6) = "plain\") Or (mID(strRTF, l, 6) = "plain ")) Then
  283.                                 If (Len(strFontColor & strFontFace) > 0) Then
  284.                                     If Not gSeekingText Then strCurLine = strCurLine & "</FONT>"
  285.                                     strFontColor = ""
  286.                                     strFontFace = ""
  287.                                 End If
  288.                                 If gAlign Then
  289.                                     strCurLine = strCurLine & "</TD></TR></TABLE><BR>"
  290.                                     gAlign = False
  291.                                 End If
  292.                                 strCurLine = strCurLine & strEOS
  293.                                 strEOS = ""
  294.                                 If mID(strRTF, l + 5, 1) = "\" Then l = l + 4 Else l = l + 5    'catch next \ but skip a space
  295.                             ElseIf (mID(strRTF, l, 9) = "pnlvlblt\") Then
  296.                                 'bulleted list
  297.                                 strEOS = ""
  298.                                 strBOS = "<UL>"
  299.                                 strBOL = "<LI>"
  300.                                 strEOL = "</LI>"
  301.                                 strEOP = "</UL>"
  302.                                 l = l + 7    'catch next \
  303.                             ElseIf (mID(strRTF, l, 7) = "pntext\") Then
  304.                                 l = InStr(l, strRTF, "}")   'skip to end of braces
  305.                             ElseIf (mID(strRTF, l, 6) = "pntxtb") Then
  306.                                 l = InStr(l, strRTF, "}")   'skip to end of braces
  307.                             ElseIf (mID(strRTF, l, 10) = "pard\plain") Then
  308.                                 strCurLine = strCurLine & strEOS & strEOP
  309.                                 strEOS = ""
  310.                                 strEOP = ""
  311.                                 strBOL = ""
  312.                                 strEOL = "<BR>"
  313.                                 l = l + 3    'catch next \
  314.                             Else
  315.                                 gSkip = True
  316.                             End If
  317.                         Case "q"
  318.                             If ((mID(strRTF, l, 3) = "qc\") Or (mID(strRTF, l, 3) = "qc ")) Then
  319.                                 'qc = centered
  320.                                 strAlign = "center"
  321.                                 'move "cursor" position to next rtf code
  322.                                 If (mID(strRTF, l + 2, 1) = " ") Then l = l + 2
  323.                                 l = l + 1
  324.                             ElseIf ((mID(strRTF, l, 3) = "qr\") Or (mID(strRTF, l, 3) = "qr ")) Then
  325.                                 'qr = right justified
  326.                                 strAlign = "right"
  327.                                 'move "cursor" position to next rtf code
  328.                                 If (mID(strRTF, l + 2, 1) = " ") Then l = l + 2
  329.                                 l = l + 1
  330.                             Else
  331.                                 gSkip = True
  332.                             End If
  333.                         Case "r"
  334.                             If (mID(strRTF, l, 7) = "rquote ") Then
  335.                                 'reverse quote
  336.                                 strTmp = "Æ"
  337.                                 l = l + 6
  338.                                 gText = True
  339.                             ElseIf (mID(strRTF, l, 10) = "rdblquote ") Then
  340.                                 'reverse doublequote
  341.                                 strTmp = "ö"
  342.                                 l = l + 9
  343.                                 gText = True
  344.                             Else
  345.                                 gSkip = True
  346.                             End If
  347.                         Case "s"
  348.                             'strikethrough
  349.                             If ((mID(strRTF, l, 7) = "strike\") Or (mID(strRTF, l, 7) = "strike ")) Then
  350.                                 strCurLine = strCurLine & "<STRIKE>"
  351.                                 strEOS = "</STRIKE>" & strEOS
  352.                                 l = l + 6
  353.                             Else
  354.                                 gSkip = True
  355.                             End If
  356.                         Case "t"
  357.                             If (mID(strRTF, l, 4) = "tab ") Then
  358.                                 strTmp = " "   'tab
  359.                                 l = l + 2
  360.                                 gText = True
  361.                             Else
  362.                                 gSkip = True
  363.                             End If
  364.                         Case "u"
  365.                             'underline
  366.                             If ((mID(strRTF, l, 3) = "ul ") Or (mID(strRTF, l, 3) = "ul\")) Then
  367.                                 strCurLine = strCurLine & "<U>"
  368.                                 strEOS = "</U>" & strEOS
  369.                                 l = l + 1
  370.                             Else
  371.                                 gSkip = True
  372.                             End If
  373.                         Case "'"
  374.                             'special characters
  375.                             strTmp2 = "{" & mID(strRTF, l + 1, 2) & "}"
  376.                             lTmp = InStr(strCodes, strTmp2)
  377.                             If lTmp = 0 Then
  378.                                 strTmp = Chr("&H" & mID(strTmp2, 2, 2))
  379.                             Else
  380.                                 strTmp = Trim(mID(strCodes, lTmp - 8, 8))
  381.                             End If
  382.                             l = l + 1
  383.                             gText = True
  384.                         Case "~"
  385.                             strTmp = " "
  386.                             gText = True
  387.                         Case "{", "}", "\"
  388.                             gText = True
  389.                         Case vbLf, vbCr, vbCrLf    'always use vbCrLf
  390.                             strCurLine = strCurLine & vbCrLf
  391.                         Case Else
  392.                             gSkip = True
  393.                     End Select
  394.                     If gSkip = True Then
  395.                         'skip everything up until the next space or "\" or "}"
  396.                         While InStr(" \}", mID(strRTF, l, 1)) = 0
  397.                             l = l + 1
  398.                         Wend
  399.                         gSkip = False
  400.                         If (mID(strRTF, l, 1) = "\") Then l = l - 1
  401.                     End If
  402.                     l = l + 1
  403.                 Case vbLf, vbCr, vbCrLf
  404.                     l = l + 1
  405.                 Case Else
  406.                     gText = True
  407.             End Select
  408.             If gText Then
  409.                 If ((Len(strFontColor & strFontFace) > 0) And gSeekingText) Then
  410.                     If Len(strAlign) > 0 Then
  411.                         gAlign = True
  412.                         If strAlign = "center" Then
  413.                             strCurLine = strCurLine & "<TABLE ALIGN=""left"" CELLSPACING=0 CELLPADDING=0 WIDTH=""100%""><TR ALIGN=""center""><TD>"
  414.                         ElseIf strAlign = "right" Then
  415.                             strCurLine = strCurLine & "<TABLE ALIGN=""left"" CELLSPACING=0 CELLPADDING=0 WIDTH=""100%""><TR ALIGN=""right""><TD>"
  416.                         End If
  417.                         strAlign = ""
  418.                     End If
  419.                     If Len(strFontFace) > 0 Then
  420.                         strFontCodes = strFontCodes & " FACE=" & strFontFace
  421.                     End If
  422.                     If Len(strFontColor) > 0 Then
  423.                         strFontCodes = strFontCodes & " COLOR=" & strFontColor
  424.                     End If
  425.                     If Len(strCurFontSize) > 0 Then
  426.                         strFontCodes = strFontCodes & " SIZE = " & lFontSize
  427.                     End If
  428.                     strCurLine = strCurLine & "<FONT" & strFontCodes & ">"
  429.                     strFontCodes = ""
  430.                 End If
  431.                 strCurLine = strCurLine & strTmp
  432.                 l = l + 1
  433.                 gSeekingText = False
  434.                 gText = False
  435.             End If
  436.         Wend
  437.  
  438.         lBOS = lEOS + 2
  439.         lEOS = InStr(lEOS + 1, strRTF, vbCrLf & "\par")
  440.         strHTML = strHTML & strEOLL & strBOS & strBOL & strCurLine & vbCrLf
  441.         strEOLL = strEOL
  442.         If Len(strEOL) = 0 Then strEOL = "<BR>"
  443.  
  444.         If lEOS = 0 Then GoTo finally
  445.         strBOS = ""
  446.         strCurLine = ""
  447.     Wend
  448.  
  449. finally:
  450.     strHTML = strHTML & strEOS
  451.     'clear up any hanging fonts
  452.     If (Len(strFontColor & strFontFace) > 0) Then strHTML = strHTML & "</FONT>" & vbCrLf
  453.  
  454.     'Add Generator Metatag if requested
  455.     If InStr(strOptions, "+G") <> 0 Then
  456.         strGen = "<META NAME=""GENERATOR"" CONTENT=""RTF2HTML by Brady Hegberg"">"
  457.     Else
  458.         strGen = ""
  459.     End If
  460.  
  461.     'Add Title if requested
  462.     If InStr(strOptions, "+T") <> 0 Then
  463.         lTmp = InStr(strOptions, "+T") + 3
  464.         lTmp2 = InStr(lTmp + 1, strOptions, """")
  465.         strTitle = mID(strOptions, lTmp, lTmp2 - lTmp)
  466.     Else
  467.         strTitle = ""
  468.     End If
  469.  
  470.     'add header and footer if requested
  471.     If InStr(strOptions, "+H") <> 0 Then strHTML = strHeader & vbCrLf _
  472.             & strHTML _
  473.             & strFooter
  474.     RTF2HTML = strHTML
  475. End Function
  476.  
  477.  
  478.  
  479.  
  480.