[AccessD] Writing raw RTF document using VBA - Solved

Hi William, Tom et all

Referring to my post from 2003-11-01, I did an implementation of this
and it rocks.

> First, here's one solution for extracting the RTF body:

> Having reached this point it's a simple matter to assemble and write
> the full RTF document ..

> I'm pretty sure this won't be able concatenate any collection of RTF
> documents whatever the size. But until further testing has been
> carried out, I guess it will be able to concatenate a vast amount of
> small RTF docs like those found and produced in an ocx controlled RTF
> memobox.

I modified the code slightly to write the RTF document item by item
and that certainly speeds up the process. A test with 20.000 small
items created in less than one minute a 8 MB RTF document which Word
used longer time to open and - having done so - reported to have a
size of 2.500 pages. Have in mind, that an RTF document written this
way is extremely compact compared to a similar but bloated document
created directly in Word.

This is the modification (main structure only):

<code stub>

  If rst.RecordCount > 0 Then
    ' Build output filename.
    strRTFFile = FunctionToCreateFileName()
    ' Set RTF header.
    strRTF = cstrRTFBodyHeader
    ' Create RTF file.
    intFile = FreeFile
    Open strRTFFile For Output As #intFile
    ' Write RTF header.
    Print #intFile, strRTF
    
    ' Concatenate RTF bodies.
    With rst
      While .EOF = False
        varMemo = LookupMemo(!ID, !Description)
        If Not IsNull(varMemo) Then
          If Not IsRTF(varMemo) Then
            varMemo = ConvTexttoRTF(varMemo, False)
          Else
            Call ClearRTFNullEnd(varMemo)
          End If
          Call AppendRTFCrLf(varMemo)
          Call ClearRTFNewLineEnd(varMemo)
          strTxt = TrimTextBodyRTF(varMemo, True) & cstrRTFFontPlain
          If Len(strTxt) > 0 Then
            Call ClearRTFFontSize(strTxt)
            strRTF = cstrRTFFontPlain & Space(1) & strTxt & cstrRTFFontPlain & cstrRTFNewLine
            ' Append this RTF paragraph.
            Print #intFile, strRTF
          End If
        End If
        .MoveNext
      Wend
      .Close
    End With
    ' Append RTF closing bracket.
    strRTF = cstrRTFBodyEnd
    Print #intFile, strRTF
    ' Close RTF file.
    Close #intFile
    ' Reset RTB object.
    strRTF = ConvTexttoRTF(vbNullString, True)
  End If

</code stub>

Happy New Year!

/gustav