How to merge data from a recordset based on a query to Word documents.
Access Archon #168
Introduction
An AW reader wrote to me asking if the document properties merge code in my Code Sample #24could be modified to merge data to Word from a query, instead of selections in a listbox. While the ItemsSelected collection of a listbox (which is used in Code Sample #24) is a very handy way to select records for a merge, sometimes it is more convenient to merge from a query, already set up to include all the records you want to merge. And you can create such a query on-the-fly, in VBA code. This article describes how to merge data from a recordset based on a query to Word documents.
Using Saved Queries to Filter Data
The sample database, Merging Data from a Recordset to Word (AA 168).mdb, has tables of data from the old Northwind sample database. The tblCustomers table has data on customers in many different countries; if you frequently send out mailings to just to customers in certain countries, you can create filters for the countries that you send mailings to most frequently, and use the queries to send out mailings.
Figure A. A form for creating labels using TypeText
The frmWordLabelsTypeText form (shown in Figure A) uses an option group to select one of four countries for the mailing (each uses a saved query that filters for that country), and offers you a choice of two Avery mailing labels documents. After selecting a Labels document and a country, clicking the Mergebutton creates a new Labels document and fills its cells with address data from tblCustomers, usin g the TypeText method to insert data from one record into one cell of the table, as shown in Figure B:
Figure B. An Avery 5160 Labels document filled with customer address data
VBA Code
The cmdMerge_Click event procedure on frmWordLabelsTypeText creates a single Labels document from the selected template and fills its cells with name and address data, using a saved query:
Private Sub cmdMerge_Click()
‘Creates a Labels document, with one address per cell
On Error GoTo ErrorHandler
Dim appWord As Word.Application
Dim ctl As Access.Control
Dim dbs As DAO.Database
Dim doc As Word.Document
Dim docs As Word.Documents
Dim fil As Scripting.File
Dim fso As New Scripting.FileSystemObject
Dim i As Integer
Dim intSaveNameFail As Boolean
Dim prps As Object
Dim rst As DAO.Recordset
Dim strAddress As String
Dim strCountry As String
Dim strCompanyName As String
Dim strDocsPath As String
Dim strDocType As String
Dim strJobTitle As String
Dim strLongDate As String
Dim strName As String
Dim strPrompt As String
Dim strQuery As String
Dim strRecordSource As String
Dim strSaveName As String
Dim strSaveNamePath As String
Dim strShortDate As String
Dim strSQL As String
Dim strTemplate As String
Dim strTemplateNameAndPath As String
Dim strTemplatePath As String
Dim strTest As String
Dim strTestFile As String
Dim strTitle As String
‘Check that a document has been selected
strTemplate = Nz(Me![cboSelectLabels].Value)
Set ctl = Me![cboSelectLabels]
If strTemplate = “” Then
strTitle = “No selection made”
strPrompt = “Please select a labels document”
MsgBox prompt:=strPrompt, _
buttons:=vbCritical + vbOKOnly, _
Title:=strTitle
ctl.SetFocus
ctl.Dropdown
GoTo ErrorHandlerExit
Else
strTemplate = ctl.Value
End If
‘Set Word application variable; if Word is not running,
‘the error handler defaults to CreateObject
Set appWord = GetObject(, “Word.Application”)
strShortDate = Format(Date, “m-d-yyyy”)
strDocsPath = GetProperty(strName:=”DocumentsPath”, _
strDefault:=””)
If Right(strDocsPath, 1) <> “” Then
strDocsPath = strDocsPath & “”
End If
strTemplatePath = GetProperty(strName:=”TemplatesPath”, _
strDefault:=””)
If Right(strTemplatePath, 1) <> “” Then
strTemplatePath = strTemplatePath & “”
End If
strTemplateNameAndPath = strTemplatePath & strTemplate
On Error Resume Next
‘Check for existence of template in template folder,
‘and exit if not found
Set fil = fso.GetFile(strTemplateNameAndPath)
If fil Is Nothing Then
strTitle = “Template not found”
strPrompt = “Can’t find ” & strTemplate & ” in ” _
& strTemplatePath & “; canceling”
MsgBox strPrompt, vbCritical + vbOKOnly
GoTo ErrorHandlerExit
End If
On Error GoTo ErrorHandler
Set docs = appWord.Documents
Set doc = docs.Add(strTemplateNameAndPath)
appWord.Visible = True
strRecordSource = “tblCustomers”
strCountry = GetProperty(strName:=”Country”, strDefault:=””)
strTemplatePath = GetProperty(strName:=”TemplatesPath”, strDefault:=””)
strQuery = “qryTempMerge”
strSQL = “SELECT * FROM ” & strRecordSource & _
” WHERE [Country] = ” & Chr(39) & strCountry & Chr(39) & “;”
Debug.Print “SQL Statement: ” & strSQL
If CreateAndTestQuery(strQuery, strSQL) = 0 Then
strTitle = “Can’t merge”
strPrompt = “There are no customers in ” & strCountry _
& “; can’t create labels”
MsgBox prompt:=strPrompt, _
buttons:=vbCritical + vbOKOnly, _
Title:=strTitle
GoTo ErrorHandlerExit
End If
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strQuery, dbOpenDynaset)
Do While Not rst.EOF
‘Write info from customer item to variables
‘Check for required address information
strTest = rst![Address]
Debug.Print “Street address: ” & strTest
If strTest = “” Then
MsgBox “Can’t create label — no street address!”
GoTo NextCustomer
End If
strTest = rst![City]
Debug.Print “City: ” & strTest
If strTest = “” Then
MsgBox “Can’t create label — no city!”
GoTo NextCustomer
End If
strTest = rst![PostalCode]
Debug.Print “Postal code: ” & strTest
If strTest = “” Then
MsgBox “Can’t create label — no postal code!”
GoTo NextCustomer
End If
strName = Nz(rst![ContactName])
strJobTitle = Nz(rst![ContactTitle])
If strJobTitle <> “” Then
strName = strName & vbCrLf & strJobTitle
End If
strCompanyName = Nz(rst![CompanyName])
strAddress = Nz(rst![Address]) & vbCrLf & _
Nz(rst![City]) & ” ” & _
Nz(rst![Region]) & _
” ” & Nz(rst![PostalCode])
Debug.Print “Address: ” & strAddress
If strCountry <> “USA” Then
strAddress = strAddress & vbCrLf & strCountry
End If
‘Insert data into labels
With appWord.Selection
.TypeText Text:=strName
.TypeParagraph
.TypeText Text:=strCompanyName
.TypeParagraph
.TypeText Text:=strAddress
.TypeParagraph
.MoveRight Unit:=wdCell
End With
NextCustomer:
rst.MoveNext
Loop
‘Check for existence of previously saved document in documents folder,
‘and append an incremented number to save name if found
strDocType = doc.BuiltInDocumentProperties(2)
strSaveName = strDocType & ” on ” & strShortDate & “.doc”
i = 2
intSaveNameFail = True
Do While intSaveNameFail
strSaveNamePath = strDocsPath & strSaveName
Debug.Print “Proposed save name and path: ” _
& vbCrLf & strSaveNamePath
strTestFile = Nz(Dir(strSaveNamePath))
Debug.Print “Test file: ” & strTestFile
If strTestFile = strSaveName Then
Debug.Print “Save name already used: ” & strSaveName
‘Create new save name with incremented number
intSaveNameFail = True
strSaveName = strDocType & ” ” & CStr(i) & _
” on ” & strShortDate & “.doc”
strSaveNamePath = strDocsPath & strSaveName
Debug.Print “New save name and path: ” _
& vbCrLf & strSaveNamePath
i = i + 1
Else
Debug.Print “Save name not used: ” & strSaveName
intSaveNameFail = False
End If
Loop
With appWord
.Selection.HomeKey Unit:=wdStory
.ActiveDocument.SaveAs strSaveNamePath
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
ErrorHandlerExit:
Set appWord = Nothing
Exit Sub
ErrorHandler:
‘Word is not running; open Word with CreateObject
If Err.Number = 429 Then
Set appWord = CreateObject(“Word.Application”)
Resume Next
Else
MsgBox “Error No: ” & Err.Number & “; Description: “
Resume ErrorHandlerExit
End If
End Sub
Supporting Files
The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site. It is accarch168.zip, which is the last entry in the table of Access Archon columns for Access Watch.
|
Document Name |
Document Type |
Place in |
|
Merge Recordset to Word (AA 168).mdb |
Access 2000 database (can also be used in higher versions of Access) |
Wherever you want |
|
Contact Letter DP.dot |
Word 97-2003 template |
Word User Templates folder, or location of your choice |
|
Customer Letter DP.dot |
Word 97-2003 template |
Word User Templates folder, or location of your choice |
|
Avery 5160 Labels.dot |
Word 97-2003 template |
Word User Templates folder, or location of your choice |
|
Avery 5161 Labels.dot |
Word 97-2003 template |
Word User Templates folder, or location of your choice |
