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
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
Related
I am using a database to extract data that I need to present. Because I need to present the data in both landscape and portrait an access report will not do the trick. I am therefore using Access vba to put the data into a word template. However when I run the code over the full data I keep encountering an automation error. The word application ceases to exist.
I have queried and I don't think I have any of the common code errors associated with this problem, so no unreferenced word objects etc. I have also replaced all references to word constants like wdcell with their integer values. I have run through the code in debug, and when I run through in debug, the code never fails. I have put in some pauses (a function that waits a specific time and performs DoEvents) to see if that helps
Function MoveMergePaste(wdInputName As String, oWord As Word.Application, oWdocMerged As Word.Document) As Long
Dim oWdocMove As Word.Document
Dim oWdocMoveMerged As Word.Document
Dim rst As Recordset
Dim strSQL As String
On Error GoTo ERR_MoveMergePaste
Pause 1
strSQL = "SELECT T.* FROM tblMovementTemp AS T INNER JOIN tblMovementHeader AS H "
strSQL = strSQL & "ON T.FundId = H.FundId ORDER BY tblPosition"
Set rst = CurrentDb.OpenRecordset(strSQL)
Pause 0.5
Set oWdocMove = oWord.Documents.Open(wdInputName)
Pause 0.5
oWdocMove.Bookmarks("PremiumDataStart").Select
rst.MoveFirst
oWord.Selection.TypeText rst!tblElement
oWord.Selection.MoveRight Unit:=12 '(wdcell)
oWord.Selection.TypeText rst!TotalUnits
rst.MoveNext
While Not rst.EOF
oWord.Selection.MoveRight Unit:=12 '(wdcell)
oWord.Selection.TypeText rst!tblElement
oWord.Selection.MoveRight Unit:=12 '(wdcell)
oWord.Selection.TypeText rst!TotalUnits
rst.MoveNext
Wend
'Start mail merge Claims
'------------------------------------------------
With oWdocMove.MailMerge
.MainDocumentType = 0 'wdFormLetters
.OpenDataSource _
Name:=CurrentProject.FullName, _
AddToRecentFiles:=False, _
LinkToSource:=True, _
Connection:="QUERY mailmerge", _
SQLStatement:="SELECT * FROM [tblMovementHeader] "
.Destination = 0 'wdSendToNewDocument
.Execute Pause:=False
End With
'Copy movement data into merged document
'------------------------------------------------
Set oWdocMoveMerged = oWord.ActiveDocument
oWdocMoveMerged.Select
oWord.Selection.WholeStory
oWord.Selection.Copy
oWdocMerged.Select
oWord.Selection.EndKey Unit:=6 '(wdstory)
oWord.Selection.PasteAndFormat (wdFormatOriginalFormatting)
MoveMergePaste = 0
EXIT_MoveMergePaste:
On Error Resume Next
'Close files
'------------------------------------------------
oWdocMove.Close SaveChanges:=False
oWdocMoveMerged.Close SaveChanges:=False
'Release objects
'------------------------------------------------
Set oWdocMove = Nothing
Set oWdocMoveMerged = Nothing
Set rst = Nothing
Exit Function
ERR_MoveMergePaste:
MoveMergePaste = Err.Number
MsgBox Err.Description
Resume EXIT_MoveMergePaste
End Function
I pass a string which is for the path of a word template, a word application object, and an existing open word document. the routine builds a record set of data, opens the word template, finds a bookmark in the template and then writes data from the recordset to the template. Once it has done this it performs a mail merge on the template and copies the data from the newly created merged document into the open document. It returns 0 if successful. It closes the template and merged document and releases the objects.
Mostly it works, but far too often to make it usable I get the automation error. '-2147023170 (800706be)'. The error usually occurs because the word has ceased to exist. If I break the code the line of code that returns the error is
oWdocMove.Bookmarks("PremiumDataStart").Select
But the line is OK, the error is because word no longer exists.
I need to show a group of records from an Access database in a message box or any form that is only for view without adding sheets to the workbook.
The information is divided into 9 fields, and are up to 15 rows per entry. I've tried several forms of showing the information, but they don't work, or add another sheet to the workbook. The environment where the workbook is used is only for data and printing capture. Apparently, I already have covered the database connection, the only issue is the display of the information.
Private Sub Srch_Click()
Dim A As Object, rs As Object, sSQL As String, CN As String, Arr As Variant, FL As Long, txt As String, i As Long
FL = tbFolio.Value - 1
Set A = CreateObject("ADODB.Connection")
CN = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=S:\Common\Quality\RASTREABILIDAD\MAIN PROJECT\PROYECTO KOREANO MX.accdb;"
sSQL = "SELECT * FROM Trazabilidad WHERE Folio = " & (FL) & ";"
A.Open CN
Set rs = A.Execute(sSQL)
Arr = rs.GetRows
MsgBox Arr, vbOKOnly, Trazabilidad
rs.Close
A.Close
Unload Me
End Sub
In the debugging, the highlighted section of the code is this:
MsgBox Arr, vbOKOnly, Trazabilidad
The error message is
"Error '13': Type mismatch"
I've been breaking my mind over how to do it, and I would appreciate any help.
Thanks in advance.
#Alex K. is right saying a good solution is to loop over the recordset.
But you may also find useful to copy the data to a sheet and then work over it using this code:
mysheet.Range("A2").CopyFromRecordset rs
As a part of a database that i am developing i have a function that i developed in Access 2010 . on presenting it to my Superiors i was asked to enhance the presentation or Display. i am just hoping someone can Point me the right direction..
so basically i am inserting some values from one table to the other. but i first run Loops to determine which field names match and copy from the Import table only those fields which match for the target table. so far it works perfectly. no Problems. i am displaying the matching field names in a msg box. the code for this field Name comparision is as follows:
Private Sub Command50_Click()
Dim n As Long
Dim m As Long
Dim Ret_Type As Integer
Dim str As String
Dim stp As String
Dim mystr As String
Dim mysas As String
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("MLE_Table")
Set rs1 = CurrentDb.OpenRecordset("tbl_Import")
With rs
For n = 0 To .Fields.Count - 1
str = CurrentDb().TableDefs("MLE_Table").Fields(n).Name
With rs1
For m = 0 To .Fields.Count - 1
stp = CurrentDb().TableDefs("tbl_Import").Fields(m).Name
Debug.Print stp
If str = stp Then
mystr = mystr & str & ", "
fnd = True
Exit For
End If
Next m
If Not fnd Then mysas = mysas & str & vbCrLf
fnd = False
End With
Next n
.Close
End With
Ret_Type = MsgBox("The Following Fields could not be found in your upload !!" & vbCrLf & mysas, vbOKOnly + vbExclamation, " MISSING DATA")
End Sub
now what my colleagues want is that this msg box is not sufficient.. they want a more detailed Display. maybe a form or a text file or something so that the user has a more clear Picture.
the Suggestion was to Show up all the fields of the target table and then Show the fields that matched as green or maybe a tick or checkmark.
i am sure this cannot be done in a msgbox. i know it sounds elegant and i am not sure it can be done. some colleagues say it can be.
can somebody Point me in the right direction or some Suggestion please. i am not experianced enough in Access, so this would be a learning experiance..
thanks in advance..
What I like to do when I want to show text or data that doesn't fit into a MsgBox (or isn't suitable), is to paste it to a new Notepad window:
Shell "notepad", vbNormalFocus
ClipBoard_SetData strText ' google this function
SendKeys "^V", True
Or if it's tabular data, I open Excel and write it to a new sheet.
Starting a separate application has the additional advantage that users can easily save the data, if necessary.
When a particular form loads I need to grab a distinct list of locations from a table, with the eventual goal of displaying them to the user (baby steps though, I'll get to that).
The code below generates no error, but when I try to loop through the recordset returned by my query, I get an error in relation to the integer i.
Run-time error '6': Overflow
I've tested the query and it does return the results that I expect, so I believe that my handling of the Recordset object my be the issue.
what am I doing wrong here?
Private Sub Form_load()
Dim DB As DAO.Database
Set DB = CurrentDb ' Set the DB object to use
'**
' Grab a recordset containing distinct locations
'*
Dim RS As DAO.Recordset
Set RS = DB.OpenRecordset( _
"SELECT DISTINCT [Active Directory].[AD Location] FROM [Active Directory]" _
)
Dim i As Integer: i = 0
Dim locations() As String
ReDim locations(0)
'**
' Make an array of the locations to display
'*
If Not (RS.EOF And RS.BOF) Then ' Ensure that the recordset is not empty
RS.MoveFirst ' Move to the first record (unnecessary here, but good practice)
'**
' Loop through the recordset and extract the locations
'*
Do Until RS.EOF = True
locations(i) = RS![AD Location]
i = i + 1
ReDim Preserve locations(i)
Loop
Else
'**
' Tell the user that there are no records to display
'*
Call MsgBox( _
"Sorry, something went wrong and there are no locations to display." & vbCrLf & vbCrLf & _
"Please ensure that the Active Directory table is not empty.", _
vbExclamation, _
"You'd better sit down, it's not good news..." _
)
End If
RS.Close ' Close the recordset
Set RS = Nothing ' Be a hero and destroy the now defunct record set
End Sub
If I'm not missing something, you could just use GetRows:
Dim locations As Variant
RS.MoveLast
i = RS.RecordCount
RS.MoveFirst
locations = RS.GetRows(i)
Thanks to #Arvo who commented that I had forgotten to move to the next record in my do loop.
Adding RS.MoveNext to the loop fixed the problem.
Do Until RS.EOF = True
locations(i) = RS![AD Location]
i = i + 1
ReDim Preserve locations(i)
RS.MoveNext
Loop
You seem to know what you are doing so my question is probably pointless as I'm sure you have a good reason, BUT... why are you stuffing the recordset values into an Array?... Or more specifically how are you displaying the results to the user in the end?
I ask because it would seem to be much simpler to just bind your SQL statement into a control (subform, combobox, listbox etc.) rather than iterating through records like your doing. But, as I said I imagine you have your reasons for doing it that way.
Is it possible to programmatically enumerate the Data Macros in an Access 2010+ database? If so, how?
Note: Data Macros are trigger-like procedures that are created in the context of the table designer UI. They were new in Acces 2010. They are NOT the same thing as normal macros, which are easy to enumerate.
They have their own new AcObjectType enumeration value : acTableDataMacro, but I can find no other aspect of the Access or DAO object model that refers to them. They do not even appear in the MSysObjects table.
This code will export DataMacro metadata to an XML Document (Source):
Sub DocumentDataMacros()
'loop through all tables with data macros
'write data macros to external files
'open folder with files when done
' click HERE
' press F5 to Run!
' Crystal
' April 2010
On Error GoTo Proc_Err
' declare variables
Dim db As DAO.Database _
, r As DAO.Recordset
Dim sPath As String _
, sPathFile As String _
, s As String
' assign variables
Set db = CurrentDb
sPath = CurrentProject.Path & "\"
s = "SELECT [Name] FROM MSysObjects WHERE Not IsNull(LvExtra) and Type =1"
Set r = db.OpenRecordset(s, dbOpenSnapshot)
' loop through all records until the end
Do While Not r.EOF
sPathFile = sPath & r!Name & "_DataMacros.xml"
'Big thanks to Wayne Phillips for figuring out how to do this!
SaveAsText acTableDataMacro, r!Name, sPathFile
'have not tested SaveAsAXL -- please share information if you do
r.MoveNext
Loop
' give user a message
MsgBox "Done documenting data macros for " & r.RecordCount & " tables ", , "Done"
Application.FollowHyperlink CurrentProject.Path
Proc_Exit:
' close and release object variables
If Not r Is Nothing Then
r.Close
Set r = Nothing
End If
Set db = Nothing
Exit Sub
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " DocumentDataMacros"
Resume Proc_Exit
Resume
End Sub
EDIT: Gord pointed out that you wanted the DataMacros opposed to standard macros. I found some code and tested it (it works) here
I tested the top function when you follow that link and it saves information regarding your table macros for each table in an XML document. It works nicely, props to whoever wrote it.