Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Option Compare Database
Option Explicit
Private Sub SetQuery(strQueryName As String, strSQL As String)
On Error GoTo ErrorHandler
[purple]'set the query from which the merge
' document will pull its info [/purple]
Dim qdfNewQueryDef As QueryDef
Set qdfNewQueryDef = CurrentDb.QueryDefs(strQueryName)
qdfNewQueryDef.Sql = strSQL
qdfNewQueryDef.Close
RefreshDatabaseWindow
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
Exit Sub
End Sub
Private Sub cmdMergeIt_Click()
[purple]'creates an SQL statement to be used in the query def[/purple]
On Error GoTo ErrorHandler
[purple]' user enters a zip code in a text box on the form;
' the query's criteria is set to pull records for
'that zip code[/purple]
Dim strPostalCode as string
strPostalCode = txtPostalCode.value
Dim strSQL As String
[purple]'replace the SQL statement below with the SQL statement
'from your query. This sample shows how to use single quotes
'to incorporate string values from the form's fields
'into the SQL statement. For dates, use # instead of the
'single quotes[/purple]
strSQL = "SELECT Contacts.LastName, Contacts.FirstName, Contacts.DistrictNo, Contacts.County, Contacts.Address, Contacts.Address2, Contacts.City, Contacts.StateOrProvince, Contacts.PostalCode, Contacts.Office, Title.Title, FROM Contacts WHERE Contacts.PostalCode = ' " & strPostalCode & " ' ;"
Dim strDocumentName As String [purple]'name of the Word template document [/purple]
strDocumentName = "\Labels With Criteria Set In Access.doc" [purple]
'use your template document name above[/purple]
Call SetQuery("qryLabelQuery", strSQL) [purple]
'use your query name above[/purple]
Dim strNewName As String [purple]'name to use when saving
'the merged document
'this next line of code makes the document name pattern
'like this: Custom Labels January 11, 2005.doc [/purple]
strNewName = "Custom Labels " & Format(CStr(Date), "MMM dd yyyy") [purple]
'use your file name pattern above[/purple]
Call OpenMergedDoc(strDocumentName, strSQL, strNewName)
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
Exit Sub
End Sub
Private Sub OpenMergedDoc(strDocName As String, strSQL As String, strMergedDocName As String)
On Error GoTo WordError
[purple]'opens an instance of Word, opens a merge template which has its data source
'already linked to a query in the database,
'optional code merges the template to a new document,
'saves the merged file with a descriptive name,
'then closes the merge template
'Set the directory for any labels generated [/purple]
Const strDir As String = "S: \Contacts" [purple]
'use your directory and folder name above[/purple]
Dim objWord As New Word.Application
Dim objDoc As Word.Document
objWord.Application.Visible = True
Set objDoc = objWord.Documents.Open(strDir & strDocName)
[purple]' Make Word visible so that if any errors occur,
' you can close the instance of Word manually [/purple]
objWord.Application.Visible = True
[green]'*optional code to merge to a new document, save the merged document, and close the template goes here*[/green]
[purple]'release the variables [/purple]
Set objWord = Nothing
Set objDoc = Nothing
Exit Sub
WordError:
MsgBox "Err #" & Err.Number & " occurred." & Err.Description, vbOKOnly, "Word Error"
objWord.Quit
End Sub
[purple]'*paste this optional code in the subroutine to
'merge the data with the template to a new document,
'save the merged document, and close the template.
'Otherwise, the above code will open the template (which
'already has the query set
'as its recordsource) and the user will need to merge the
'template to a new document using the toolbar in Word
'Merge to a new document
'if you are not sure of the SQLStatement to use in your
'OpenDataSource string, uncomment the following four
'lines to have the current SQLstatement print in the
'immediate window. You can then copy the returned string 'into your code[/purple]
[blue] 'Debug.Print objWord.Application.ActiveDocument.MailMerge.DataSource.QueryString
'objWord.quit
'set objWord = nothing
'exit sub[/blue]
[purple]'replace the file path and query name below with the path
'to your database and your query name[/purple]
objDoc.MailMerge.OpenDataSource _
Name:="S:\Exec\Contacts\Contacts.mdb", _
LinkToSource:=True, AddToRecentFiles:=False, _
Connection:="QUERY qryLabelQuery", _
SQLStatement:="SELECT * FROM [qryLabelQuery]"
[purple]'notice that the SQLStatement above is not the SQL
'statement that makes up the QueryDef of the query. It is
'the SQL statement that tells Word whether or not to use all the records returned by the Query[/purple]
objDoc.MailMerge.Destination = wdSendToNewDocument
objDoc.MailMerge.Execute
[purple]'save the merged document with a descriptive name
' you can delete this next line if you don't want to save
' the merged document
' it will leave the document with the default name
'"Labels 1" or "Letters 1"[/purple]
objWord.Application.Documents(1).SaveAs (strDir & "\" & strMergedDocName & ".doc")
[purple]'close the merge template without saving[/purple]
objWord.Application.Documents(2).Close wdDoNotSaveChanges