Copy RTF text from Access to word table using VBA

时光毁灭记忆、已成空白 提交于 2019-11-28 01:20:23

问题


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?


回答1:


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


来源:https://stackoverflow.com/questions/16350527/copy-rtf-text-from-access-to-word-table-using-vba

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!