使用vba将格式化文本复制到访问中

Question

我需要在Access数据库中保存Word中的格式化文本.

到目前为止,我已经设法找出如何在访问字段中存储格式化文本(在表中创建备注字段并将文本格式设置为富文本).正在搜索SO我还没有遇到如何将所述文本从单词传输到Access的解决方案.

我知道这是可能的,因为如果您手动执行此操作,只需复制和粘贴信息即可.

我的问题是,如何使用VBA将格式化文本从word复制到表中的字段？

通过实验我创建了以下内容来测试它.到目前为止没有成功......

Sub GetComments()
'Imports Analyst Comments from Excel files als OLE Objects.
'---------------------------------

'Access Variables
Dim dbsFundDB As DAO.Database
Dim rsComments As DAO.Recordset

Set dbsFundDB = CurrentDb
Set rsComments = dbsFundDB.OpenRecordset("tblFunds")

'Word Variables
Dim doc             As Word.Application
Dim dcmt            As Word.Document
Dim sectn           As Word.Section
Dim obCommentText   As Object
Dim sAnalystText    As String

'Open New Word File
Set doc = New Word.Application
doc.Visible = True
Set dcmt = doc.Documents.Open(sPathTemplate)
Set sectn = dcmt.Sections(1)

sectn.Range.Select
Selection.InsertFile FileName:="myfile.rtf", Range:="", _
  ConfirmConversions:=False, Link:=False, Attachment:=False

sAnalystText = sectn.Range.Tables(1).cell(1, 1).Range.FormattedText

rsComments.AddNew
rsComments![Long Comment Exec] = sAnalystText
rsComments.Update

sectn.Range.Select
dcmt.Close savechanges:=False
doc.Quit

End Sub

更新我尝试实施马特霍尔的答案.虽然文本确实已复制到数据库,但它还没有保留格式:

这是我的实现作为一个简单的测试:

Option Explicit
Public Const sPathTemplate As String = "W:\L\BDTP\Products\FundResearchTool\Advisory.docx"
Option Compare Database

Sub GetComments()
'Imports Comments from word and save in DB
'Test soubroutine
'---------------------------------

'Word Variables
Dim obCommentText As Variant
Dim strSQL As String

obCommentText = GetWordContent(sPathTemplate)

strSQL = "insert into [tblText]([TestField]) values('" & obCommentText & "')"

DoCmd.RunSQL strSQL
MsgBox "Import Successful", vbInformation Or vbOKOnly

End Sub
Private Function GetWordContent(strFile As String) As Variant

    ' This function takes the path obtained to the MS-Word Document selected in
    ' the FileToOpen function and then uses that to open that MS-Word Document
    ' and retrieve its text contents

    Dim objDoc As Word.Document

    Set objDoc = GetObject(strFile)

    GetWordContent = CVar(objDoc.Sections(1).Range.Text)

    objDoc.Close

End Function

Answer 1

这是一个大量引用它的方法.

在开始之前,请确保在VBA编辑器>工具>参考中勾选了这些(或Access版本的等效参考)参考:

Microsoft Word 15.0对象库

Microsoft Office 15.0对象库

假设您已设置一个带有命令按钮的表单来触发此MS-Word导入,请将以下函数和子例程放在该表单的VBA模块中:

1)文件选择器功能:

这将允许您选择要使用在整个Windows中看到的旧熟悉的文件对话窗口的MS-Word文档.最终,它所做的就是保存您在(2)中描述的子程序中选择使用的文件的文件路径和名称...

Private Function FileToOpen() As String

    ' This function will essentially allow you to browse to MS-Word document
    ' and then store the path of that file for use in the GetWordContent function

    Dim fDialog As Office.FileDialog
    Dim varFile As Variant

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog

        .AllowMultiSelect = False
        .Title = "Select Word document to import"
        .Filters.Clear
        .Filters.Add "Word files", "*.doc?"

        If _
            .Show = True _
        Then
            For Each varFile In .SelectedItems

                FileToOpen = varFile

            Next

        Else

            FileToOpen = ""

        End If

    End With

End Function

2)获取MS-Word文档子程序的格式化文本内容:

此子例程将使用文件选择器功能(上面)中选择的MS-Word文档的文件路径和名称来打开MS-Word文档,选择所有文本,将其复制到剪贴板,将其粘贴到文本框中在Access中打开一个表单然后关闭MS-Word ...

Private Sub GetWordContent(strFile As String)

    ' This function takes the path obtained to the MS-Word Document selected in
    ' the FileToOpen function and then uses that to open that MS-Word Document
    ' and retrieve its text contents and paste them in to WordDocData textbox on
    ' the currently open form in Access

    ' Create an MS-Word Object:

    Dim objDoc As Object
    Set objDoc = CreateObject("Word.Application")

    ' Open the file selected in FileToOpen() and copy the contents to clipboard:

    With objDoc

        .Documents.Open strFile
        .Visible = True
        .Activate
        .Selection.WholeStory
        .Selection.Copy

    End With

    ' Set the focus to the WordDocData textbox on the Access Form and paste clipboard:

    Me.WordDocData.SetFocus
    DoCmd.RunCommand acCmdPaste

    Me.WordDocDataSrc = strFile

    ' Save record on the form:

    If _
        Me.Dirty _
    Then

        Me.Dirty = False

    End If

    ' A bit hacky this bit. When you close MS-Word after copying a lot of data,
    ' you might get a message asking you if you if you want to keep the last item
    ' you copied. This essentially overwrites the clipboard that currently has
    ' the whole document stored, to just the first 5 characters, which should allow
    ' MS-Word to be closed here without a pop-up message to deal with:

    With objDoc

        .Selection.HomeKey Unit:=wdLine
        .Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
        .Selection.Copy
        .Documents.Close
        .Quit

    End With

    Set objDoc = Nothing

End Sub

您的命令按钮的点击事件:

应该从命令按钮的单击事件运行此子例程.它本质上调用FileToOpen函数和GetWordContent子例程,以便用户选择MS-Word文档,然后让VBA将MS-Word文档中的格式化文本复制并粘贴到Access中打开表单上的富文本备忘录文本框中.

请注意,此子例程做了一些假设,并引用了控件/表/字段的名称以及您可能尚未设置的内容.这些假设是:

1. 表单的命令按钮名为cmdGetWordData
2. 您的Access数据库有一个名为tblWordDump的表
3. 您的表单绑定到表tblWordDump
4. tblWordDump有2个备忘录文本字段,分别称为WordDocDataSrc和WordDocData,用于存储导入的文件路径/名称和文本内容,两者都添加到表单中

Private Sub cmdGetWordData_Click()

    ' This subroutine runs on your command button; it will call both the FileToOpen function and GetWordContent subroutine
    ' to retrieve the text contents of your chosen MS-Word Document.
    ' It will then store both the path the text contents of of your chosen MS-Word Document in 2 fields in a table in Access.

    ' NOTE: this code assumes that your Access database has:
    ' - a table called tblWordDump
    ' - a memo text field in this table called WordDocDataSrc to store the path of MS-Word file imported
    ' - a memo text field in this table called WordDocData with the TextFormat property set to "Rich Text",
    '   which will store the text and text formating of the MS-Word file imported

    Dim strFile As String
    Dim strWordContent As Variant

    ' Select file via File Dialogue

    strFile = FileToOpen

    ' Conditionals when a file was or wasn't selected

    If _
        Len(strFile) > 0 _
    Then

        DoCmd.GoToRecord , , acNewRec

        GetWordContent strFile

        MsgBox "Import Successful", vbInformation Or vbOKOnly

    Else

        MsgBox "No File Selected", vbExclamation Or vbOKOnly

    End If

End Sub

这是一个示例访问文件,供您查阅.