Question

有没有办法使用VBA将Access数据库中的备注字段中的RTF文本复制到Word文档。我目前有这个代码，但它产生html文本（文本包含标签而不是格式化）。

' 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

还有其他办法吗？

Answer 1

请注意，备注字段的“富文本”选项不会将格式化文本存储为RTF。格式化文本存储为HTML，这就是您在文本中看到HTML标记的原因。

以下Access VBA代码创建包含格式化文本的Word文档，并保存为.rtf。如果您未承诺使用RTF，则可以轻松修改代码以将文档保存为.doc或.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

Answer 2

我想为 Excel 中的纯文本添加格式，并最终使用搜索和替换将 Markdown **Stuff in Bold** 和 *Stuff in Italic* 转换为格式化文本。

添加其他 Markdown 格式很简单。

我创建了一个文本框 (ActiveDocument.Shapes.Range(1)) 并在该文本框中插入了我想要格式化的 MailMergefield。

文本框中的记录远远超过 255 个字符并且显示正常。

Sub SearchAndReplace()
'
' Search and Replace Macro
'
'
    Set myshape = ActiveDocument.Shapes.Range(1)
    Set myrange = myshape.TextFrame.TextRange
    myrange.Find.ClearFormatting
    myrange.Find.Replacement.ClearFormatting
    myrange.Find.Replacement.Font.Bold = True
    With myrange.Find
        .text = "(\*\*)(*)(\*\*)"
        .Replacement.text = "\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    myrange.Find.Execute Replace:=wdReplaceAll
    
    Set myshape = ActiveDocument.Shapes.Range(1)
    Rem myshape.Fill.ForeColor.RGB = RGB(0, 255, 0)
    Set myrange = myshape.TextFrame.TextRange
    myrange.Find.ClearFormatting
    myrange.Find.Replacement.ClearFormatting
    myrange.Find.Replacement.Font.Italic = True
    With myrange.Find
        .text = "(\*)(*)(\*)"
        .Replacement.text = "\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    myrange.Find.Execute Replace:=wdReplaceAll
    
End Sub

使用VBA将Access中的RTF文本复制到word表

2 个答案: