MS-Access

Question

我正在为小型家族企业（养狗）创建一个 Access 2019 数据库，因此我设置了一些 table，其中包含有关狗和主人的所有详细信息。仅供参考（简单描述情况）：

Dogs
    Name
    Birth
    Microchip
    Etc…

Owners
    Name
    Address
    Etc…

我现在正在尝试为我们出售狗时创建一个“合同作曲家”。所以我做了一个新的table“合同”和一个相关的表格

Contract
    Seller ->linked to Owners table
    Buyer ->linked to Owners table
    Dog ->linked to Dogs table
    Price

并进行查询以从相关的 table 中提取所有相关信息，以便我可以

ContractQuery
    Seller!Name
    Seller!Address
    Buyer!Name
    Buyer!Address
    Dog!Name
    Dog!Birthdate
    Dog!Microchip
    Contract!Price

目前一切正常。现在我需要以“人类可读”合同的形式转换 ContractQuery 字段。我认为最好的方法是将 MailMerge 合并到特定的 Word 文档，我已经设置了一个。我的问题是：如何在合同表单中设置一个按钮，以便“contract.doc”填充我现在在表单中看到的特定记录？我做了一些研究，我发现的最相关的信息是这个 https://www.access-programmers.co.uk/forums/threads/run-mail-merge-from-vba.158126/ 还有这个 https://www.tek-tips.com/faqs.cfm?fid=3237 但是它们与旧的 MS-Access 有关，所以当我尝试应用它时，我到处都是错误。不幸的是，我的 VBA 知识还远远不够精通，我无法使其发挥作用。任何人都可以帮助我，或向我提出解决方案吗？在此先感谢您的任何建议

Answer 1

好的，感谢 Kostas K，我让它工作了，为我指明了战斗方向。这是我的最终代码，它可能需要一些清理和调整（例如，结果中的循环现在是多余的，因为我只有一个结果），但它正在工作:)

解决方案基于此post，如果有人需要，请查看它作为模板 docx 等的参考


Option Explicit

Private Sub cmdMergeIt_Click()
On Error GoTo Trap
    ' **** defining project path as string to make this portable
    Dim CurPath As String
    CurPath = CurrentProject.path & "\"
    ' MsgBox (CurPath) 'debug

    Dim TEMPLATE_PATH As String
    TEMPLATE_PATH = CurPath & "Contratto.dotx"

    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim rs As DAO.Recordset
    Dim idx As Long
    ' *** intercepting the contract ID field from the launching form
    Dim checkID As String
    checkID = ID.Value
    'MsgBox (checkID) 'debug
    
    ' **** defining a SQL query on my Access query
    Dim strSQL As String
    strSQL = "Select * from qContratto where ID =" & checkID & ""
    ' MsgBox (strSQL) 'debug
       

    Set wApp = New Word.Application
    wApp.Visible = False
    ' ***** changed the OpenRecordset to call my strSQL query insetad than reading the whole Access query
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    If rs.EOF Then GoTo Leave

    With rs
        .MoveLast
        .MoveFirst
    End With

    For idx = 1 To rs.RecordCount
        Set wDoc = wApp.Documents.Add(TEMPLATE_PATH)
        With wDoc
            .Bookmarks("Prezzo").Range.Text = Nz(rs!Prezzo, vbNullString)
            .Bookmarks("Venditore").Range.Text = Nz(rs!Venditore, vbNullString)
            .Bookmarks("Acquirente").Range.Text = Nz(rs!Acquirente, vbNullString)
            .Bookmarks("Cessione").Range.Text = Nz(rs!Cessione, vbNullString)
            .Bookmarks("NomeCane").Range.Text = Nz(rs!NomeCane, vbNullString)
            .Bookmarks("Riproduzione").Range.Text = Nz(rs!Riproduzione, vbNullString)
            .Bookmarks("Sesso").Range.Text = Nz(rs!Sesso, vbNullString)
            .ExportAsFixedFormat CurPath & rs!Acquirente & ".pdf", wdExportFormatPDF, False, wdExportOptimizeForOnScreen
            .Close wdDoNotSaveChanges
            
        ' in the ExportAsFixedFormat here above called one of the SQL query values to make a unique and distinctive name. Also please note use of CurPath for portability
        
        End With
        Set wDoc = Nothing
        rs.MoveNext
    Next

Leave:
    On Error Resume Next
    If Not rs Is Nothing Then rs.Close
    If Not wDoc Is Nothing Then wDoc.Close wdDoNotSaveChanges
    If Not wApp Is Nothing Then wApp.Quit wdDoNotSaveChanges
    On Error GoTo 0
    Exit Sub

Trap:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub

MS-Access - 来自表单的 MailMerge 特定记录

MS-Access - MailMerge specific record from a form

vba