I am creating an Access 2019 database for small family business (dog breeding) so I setup some tables containing all details on the dogs and the owners. Just to give an idea (simplistic description of the situation):
Dogs
Name
Birth
Microchip
Etc…
Owners
Name
Address
Etc…
I was now trying to create a "Contract composer" for when we sell the dogs. So I made a new table "Contract" and a related form
Contract
Seller ->linked to Owners table
Buyer ->linked to Owners table
Dog ->linked to Dogs table
Price
And made a query to pull all relevant information from the related tables so that I can have
ContractQuery
Seller!Name
Seller!Address
Buyer!Name
Buyer!Address
Dog!Name
Dog!Birthdate
Dog!Microchip
Contract!Price
Everything so far is working perfectly fine. Now I need to convert the ContractQuery fields in a form of "human readable" contract. I think the best way to do so is the MailMerge to a specific Word document, and I've already setup one. My problem is: how can I set a button into the Contract form so that the "contract.doc" is populated with the specific record I'm seeing now in the form? I had made some researches and the most relevant information I've found is this https://www.access-programmers.co.uk/forums/threads/run-mail-merge-from-vba.158126/ and this https://www.tek-tips.com/faqs.cfm?fid=3237 But they are related to old MS-Access so when I tried to apply it I had errors all around. Unluckily my VBA knowledge is far from being proficient and I was not able to make it work. Can anyone help me, or address me to a solution? Thanks in advance for any advice
CodePudding user response:
OK I got it working thanks to Kostas K, pointing me in the fight direction. This is my final code, it might need some cleanup and tweaking (for example, the loop within the resulst is now redundant as I only have one result), but it is working :)
The solution is based on this post, should anyone need please have a look at it as reference for the template docx etc
Generating completed PDF forms using word docs and ms access
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