Copy RTF text from Access to word table using VBA

Question

Is there a way to copy a RTF text from a memo field in Access Database to Word document using VBA. I have this code at the moment but it produces html text (the text includes tags and not formatted).

' Query the database and get the sales for the specified customer
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Sales WHERE Sales.[ID] ='" & Forms![customers]![id] & "'")

'Check to see if the recordset actually contains rows
    If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst
    Do Until rs.EOF = True

    ' Create file and add rtf text
    Set ts = fso.CreateTextFile("c:\temp\temp.rtf", True)
    ts.Write rs(3)
    ts.Close

    ' Add a row
    doc.Tables(1).Rows.Add

    ' Get the number of the added row to add data
     i = doc.Tables(1).Rows.Last.Index

    ' Add sale to word table
    doc.Tables(1).Cell(i, 2).Range.InsertFile "C:\temp\temp.rtf", , False


    'Move to the next record. Don't ever forget to do this.
    rs.MoveNext
   Loop
Else
    MsgBox "There are not records in the recordset."
End If

MsgBox "Finished." & i

rs.Close
Set rs = Nothing

Is there any other way to do this?

Gord Thompson Gord Thompson · Accepted Answer · 2013-05-03T08:31:28

Note that the "Rich Text" option for Memo fields does not store the formatted text as RTF. The formatted text is stored as HTML, which is why you were seeing HTML tags in your text.

The following Access VBA code creates a Word document that contains formatted text and is saved as .rtf. If you're not committed to using RTF then the code could easily be modified to save the document as .doc or .docx.

Sub FormattedTextToWord()
    Dim objWord As Object  ' Word.Application
    Dim fso As Object  ' FileSystemObject
    Dim f As Object  ' TextStream
    Dim myHtml As String, tempFileSpec As String

    ' grab some formatted text from a Memo field
    myHtml = DLookup("Comments", "MyTable", "ID=101")

    Set fso = CreateObject("Scripting.FileSystemObject")  ' New FileSystemObject
    tempFileSpec = fso.GetSpecialFolder(2) & "\" & fso.GetTempName & ".htm"

    ' write to temporary .htm file
    Set f = fso.CreateTextFile(tempFileSpec, True)
    f.Write "<html>" & myHtml & "</html>"
    f.Close
    Set f = Nothing

    Set objWord = CreateObject("Word.Application")  ' New Word.Application
    objWord.Documents.Add
    objWord.Selection.InsertFile tempFileSpec
    fso.DeleteFile tempFileSpec
    ' the Word document now contains formatted text

    objWord.ActiveDocument.SaveAs2 "C:\Users\Public\zzzTest.rtf", 6  ' 6 = wdFormatRTF
    objWord.Quit
    Set objWord = Nothing
    Set fso = Nothing
End Sub

Copy RTF text from Access to word table using VBA

1 Answers