More on how to merge data from recordsets and queries to Word documents.
Access Archon #168
Creating Queries on-the-fly for Filtering Data
If you need to send letters to customers, and want the option of filtering by any country, not just the ones with the most customers, the frmMergeToWordDocProps form (shown in Figure D) offers another selection method: a combo box displays all the countries from tblCustomers, and the selected country name is used to create a filtered query programmatically, which is then used to create a recordset for merging the data.
Figure D. A form for merging data to Word using Doc Properties
After selecting a letter and a country, when you click the Merge button, a set of letters is generated, with document properties filled from a record for each letter, and the letters are left open. Figure E shows a letter created from the Customer Letter template:
Figure E. A letter to customers in a country selected on-the-fly
Note: The main menu of the sample database uses components of the FileSystemObject to allow users to select the Templates folder and Documents folder. See Chapter 9 of my new book, Access™ 2007 VBA Bible For Data-Centric Microsoft Applications, for more details on working with the FileSystemObject.
VBA Code
The cmdMerge_Click event procedure on frmMergeToWordDocProps creates a set of letters based on the selected letter template, one per customer in the filtered recordset, created on-the-fly for the selected country:
Private Sub cmdMerge_Click()
‘Creates a set of documents, one per customer
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 lst As Access.ListBox
Dim prps As Object
Dim rst As DAO.Recordset
Dim strAddress As String
Dim strCompanyName As String
Dim strContactName 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 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 letter has been selected
strTemplate = Nz(Me![cboSelectLetter].Value)
Set ctl = Me![cboSelectLetter]
If strTemplate = “” Then
MsgBox “Please select a letter”
ctl.SetFocus
ctl.Dropdown
GoTo ErrorHandlerExit
Else
strTemplate = ctl.Value
End If
‘Check that a country has been selected
strCountry = Nz(Me![cboSelectCountry].Value)
Set ctl = Me![cboSelectCountry]
If strCountry = “” Then
strTitle = “No selection made”
strPrompt = “Please select a country”
MsgBox prompt:=strPrompt, _
buttons:=vbCritical + vbOKOnly, _
Title:=strTitle
ctl.SetFocus
ctl.Dropdown
GoTo ErrorHandlerExit
Else
strCountry = ctl.Value
End If
‘Set Word application variable; if Word is not running,
‘the error handler defaults to CreateObject
Set appWord = GetObject(, “Word.Application”)
strLongDate = Format(Date, “mmmm d, yyyy”)
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
‘Create filtered query on-the-fly
strQuery = “qryFilteredCustomers”
strSQL = “SELECT * FROM tblCustomers ” _
& “WHERE [Country] = ” & Chr(39) & strCountry _
& Chr(39) & “;”
Debug.Print “SQL Statement: ” & strSQL
If CreateAndTestQuery(strQuery, strSQL) = 0 Then
strTitle = “No records found”
strPrompt = “There are no customer records for ” _
& strCountry & “; canceling”
MsgBox prompt:=strPrompt, _
buttons:=vbCritical + vbOKOnly, _
Title:=strTitle
GoTo ErrorHandlerExit
End If
‘Create recordset based on filtered query
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strQuery)
Do While Not rst.EOF
‘Check for required address information
If Nz(rst![Address]) = “” Then
GoTo ErrorHandlerExit
End If
If Nz(rst![City]) = “” Then
GoTo ErrorHandlerExit
End If
If Nz(rst![PostalCode]) = “” Then
GoTo ErrorHandlerExit
End If
‘Save variables for current record
strContactName = 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
‘Create a new letter based on the selected template
Set doc = appWord.Documents.Add(strTemplate)
‘Write information to Word custom document properties
Set prps = doc.CustomDocumentProperties
On Error Resume Next
prps.Item(“ContactName”).Value = strContactName
prps.Item(“CompanyName”).Value = strCompanyName
prps.Item(“Address”).Value = strAddress
prps.Item(“Country”).Value = strCountry
prps.Item(“TodayDate”).Value = strLongDate
On Error GoTo ErrorHandler
‘Check for existence of previously saved letter in documents folder,
‘and append an incremented number to save name if found
strDocType = doc.BuiltInDocumentProperties(2)
strSaveName = strDocType & ” to ” & strContactName
strSaveName = strSaveName & ” 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) & ” to ” & _
strContactName
strSaveName = strSaveName & ” 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
‘Update fields in Word document and activate it
With appWord
.Selection.WholeStory
.Selection.Fields.Update
.Selection.HomeKey Unit:=wdStory
.ActiveDocument.SaveAs strSaveNamePath
End With
rst.MoveNext
Loop
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
References
The code in the sample database needs the following references (in addition to the default references):
Microsoft DAO 3.6 Object Library
Microsoft Scripting Runtime
Microsoft Word 11.0 Object Library
If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.
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 |
