将数据从 Word 书签传递到 Access 表单中的字段

Question

我正在编写将数据从 Access 表单（在将表单保存到表中之前）传递到 Word 文档中的书签的 VBA 代码。

它运行良好，但用户可能会在保存 Word 文档之前对其进行编辑，因此我需要代码将数据从 Word 书签返回到 Access 表单（之前打开过）。假设我只是将一个书签数据传递给表单中的一个字段，我需要清除该字段然后将数据传递给它。

我看到了一些从 Word 传递到 Access 表的方法，但我正在寻找传递到表单的方法。

以下从 Access 传递到 Word 的代码运行良好：

Private Sub Command68_Click()
Call fillWordForm
End Sub

---

    Function fillWordForm()

Dim appWord As Object
Dim doc As Object
Dim path As String
Dim myID As String

On Error Resume Next
Error.Clear

Set appWord = CreateObject("word.application")
If Err.Number <> 0 Then
Set appWord = New Word.Application
appWord.Visible = True
End If

path = Application.CurrentProject.path & "\H_F.docx"


If FileExists(path) = False Then
MsgBox "Template File Not Found", vbExclamation, "File Not Found"
Else
Set doc = appWord.Documents.Add(path, , True)
myID = DLookup("ID", "Exports_imports_Table", "[ID] = " & Me.ID)
With doc
.FormFields("BookID").Result = [ID]
.FormFields("Book_BC_date").Result = Me.date_BC
.FormFields("Book_AH_date").Result = Me.date_AH
.FormFields("Book_AH_date").Result = Me.date_AH
.FormFields("BookTopic").Result = Me.topic
.FormFields("BookProjectName").Result = Me.projectName
.FormFields("BookCompanyName").Result = Me.companyName
.FormFields("BookContent").Range.Text = Me.content

'Result = Me.content

appWord.Visible = True
appWord.Active
End With
Set doc = Nothing
Set appWord = Nothing

End If
End Function

---

Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
'Purpose:   Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
'           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
'Note:      Does not look inside subdirectories for the file.
'Author:    Allen Browne. http://allenbrowne.com June, 2006.
Dim lngAttributes As Long

'Include read-only files, hidden files, system files.
lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

If bFindFolders Then
    lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
Else
    'Strip any trailing slash, so Dir does not look inside the folder.
    Do While Right$(strFile, 1) = "\"
        strFile = Left$(strFile, Len(strFile) - 1)
    Loop
End If

'If Dir() returns something, the file exists.
On Error Resume Next
FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function

Answer 1

以下内容对我有用。您需要将我的测试字符串替换为适合您环境的字符串（boomkark 名称、表单名称、控件名称）。

注释掉的是打开表单的行，因为我有它并且它可能会引起某人的兴趣。

Sub AutomateAccessForm()
    Dim accApp As Access.Application
    Dim sData as String

    sData = ActiveDocument.Bookmarks("X").Range.Text
    Set accApp = GetObject(, "Access.Application")
    '''    accApp.DoCmd.OpenForm "Source Bücher"

    accApp.DoCmd.GoToControl "Bemerkungen"
    accApp.Forms("Source Bücher").ActiveControl.SetFocus
    accApp.Forms("Source Bücher").ActiveControl.Text = sData
    Set accApp = Nothing
End Sub