Exporting Access Data to Word Documents

Word offers several document types that are useful for creating merge documents. In addition to standard templates, you can create templates based on mail merge documents, catalog merge documents, and label documents to use in mail merge from Access. Documents made from these different types of templates can be filled with data from Access in a variety of ways, as described in the following sections.

Merge Types

There are several ways you can export data from Access tables to Word documents, each with its advantages and disadvantages, described in the following sections.

Mail Merge

A mail merge involves a link between an Access table or query (or some other data source), and a Word mail merge document. The Word document has to be set up with a link to a specific data source.

Advantage:

• Mail merge can handle very large numbers of records, more than you could generate as separate Word documents.

Disadvantages:

• A Word mail merge document must be prepared, with its data source set up and merge fields placed as needed.

• If you move or rename the data source, the Word mail merge document won’t work properly (however, this problem can be avoided—at least for mail merges run from Access—by creating and assigning the data source in code).

• Mail merges can be very slow, and memory-intensive.

• It is difficult to customize a single merge record, because it is part of a huge merge document.

Document Properties

This method (my personal favorite) involves writing data to custom document properties (abbreviated doc properties) in a Word document. A separate Word document is created for each Access record.

Advantages:

• Each record has its own Word document, which makes it easy to customize one or a few of the documents.

• Since the data is stored in doc properties, the same piece of data (such as an address) can be displayed in multiple DocProperty fields on the same document. This is handy when doing a letter and envelope together.

Disadvantages:

• The Word document must be prepared with the required doc properties.

• Users may not realize that the merge data comes from doc properties and may type over information in a DocProperty field, only to see it revert to the stored data when the document is printed and the fields are refreshed. Depending on whether security or freedom to modify the documents is more important, this may be an advantage or disadvantage.

Bookmarks

Data is written to bookmarks in a Word document. A separate Word document is created for each Access record.

Advantage:

• The data written to bookmarks is just text in the document and can be overwritten (for purposes of customizing one or more documents) without any problems. As with the Doc Properties method, this can be either an advantage or a disadvantage.

Disadvantages:

• The Word document must be prepared with the required bookmarks.

• Each bookmark has its own name, so if you need to write data to multiple locations in a document (say the name and address for a letter and its envelope), you need to write the same data to two (or more) bookmarks.

TypeText Method

You can write Access data directly to a Word document, using the TypeText method of the Word Selection object. This method is generally used for simple tabular data, such as mailing labels. You can either create a single document with all the data (labels) or a separate document for each record (letters).

Advantage:

• The method is very simple and requires no preparation of Word documents or templates—you can even write data using TypeText to a newly created, blank Word document.

Disadvantage:

• It is difficult to use this method to create documents with any significant formatting because there is no way to target the data to a specific location.

Merge Examples

The sample database, Word Data Exchange.mdb, illustrates exporting Access data to Word using all of the techniques just described. It contains several tables of data that you might want to export to Word documents—a table of contacts (tblContacts), and several linked tables of information about ebooks (tblAuthors, tblEBooks, and tblEBookAuthors).

Main Menu

The main menu of this database was created using my Menu Manager add-in (see Chapter 6, Printing Data with Reports, for a discussion of this add-in), with some modifications. My standard main menu includes controls for selecting a Word letter and recipient, for a convenient way of sending a standard letter to a single recipient. For the Word Data Exchange database, I added a txtLetterText textbox, to allow entry of a few sentences of text for a freestyle letter (as opposed to a saved template with boilerplate text), and a Docs Path textbox, to allow editing the Documents path (this path is picked up from tblInfo in various procedures in the database).

The main menu is bound to the information table, tblInfo, which contains miscellaneous information to be used throughout the database. I added three more fields to this table, MergeType, LetterText, and DocsPath, to use for doing mail merges of various types. The MergeType field holds an integer representing the type of letter to be created (1 for Boilerplate or 2 for Freestyle). A Boilerplate letter has standard text in the template; a Freestyle letter picks up the text entered into the txtLetterText control on the menu (this control is bound to the LetterText field in tblInfo). The DocsPath field stores the user’s Documents path, for use in saving documents.

Several standard Word templates are included in the sample files; they are listed in tlkpTemplates. The doc properties versions of the Boilerplate and Freestyle contact letters, and a One-up Label, are used for the main menu. To test creating a boilerplate letter, select Boilerplate Contact Letter from the Word Letter combobox, and a recipient from the Recipient combobox, as shown in Figure 11.11, and click the large Word button.

Figure 11.11

The cmdLetters button’s Click event procedure follows. The code starts by declaring variables to use in creating the letter. Although you can write data from Access fields directly to Word doc properties, I prefer to assign most values to variables, using the Nz function to prevent Nulls from being assigned to the variables (and thus to the doc properties), since Nulls can cause problems.

Important

The prps variable (representing the Word custom doc properties) must be declared as Object, because if it is declared as Word.CustomProperties—the “correct” data type—it doesn’t work. You get no error message, but no data is written to the doc properties.

Two If . . . Then structures check that a letter and a recipient have been selected, and exit the procedure if one or the other is missing. Next, a gappWord variable is set, to allow working with Word, using the GetObject function with a fallback to CreateObject in the error handler, as described in the “Basic Automation Commands” section earlier in this chapter.

Next, variables are assigned the values of the Access Merge subfolder under the user’s Documents path (which is picked up from tblInfo, via the GetDocsDir function) and the User Templates folder, picked up from the Word Options dialog via the TemplateDir function. The code looks for the selected template in the Templates\Access Merge folder, and if it is not found, puts up an informative message and exits the procedure. If there is no Access Merge subfolder under the Documents folder or the Templates folder, this subfolder is created in the GetDocsDir or TemplateDir function, using the FileSystemObject’s CreateFolder method.

The FileSystemObject is part of the Microsoft Scripting Runtime library, so databases using this object need to have a reference set to this library.

Finally, a new document is created based on the selected template, and a section of code assigns values to name and address variables from fields in qryContacts for the selected recipient, picked up from columns of cboRecipients.

When picking up data from a column of a combobox, note that column numbering is zero-based, so to reference the third column, you need to use the syntax cboRecipients.Column(2).

Because this procedure is used to create both boilerplate and freestyle letters, an If . . . Then structure determines whether text from txtLetterText should be written to the LetterText doc property. Next, a section of code creates a save name for the document, based on text in the template’s Subject property, the recipient’s name, and the current date, and checks whether a document with this name exists in the Documents\Access Merge folder. If it does, then an incrementing number is added to the name, so you won’t overwrite an existing document. If you don’t need to preserve multiple copies of letters, you can comment out or delete the code that creates the incrementing number for the save name, and just overwrite earlier versions of letters, if they exist.

The final section of code updates fields for the new document, saves it with the save name just created, and makes it visible.

 Private Sub cmdLetters_Click() On Error GoTo ErrorHandler    Dim strLetter As String    Dim strRecipient As String    Dim strTestFile As String    Dim cbo As Access.ComboBox    Dim docs As Word.Documents    Dim strLongDate As String    Dim strShortDate As String    Dim strDocType As String    Dim strName As String    Dim strSaveName As String    Dim i As Integer    Dim intSaveNameFail As Integer    Dim strSaveNamePath As String    Dim strJobTitle As String    Dim strNameAndJob As String        ‘Must declare as Object because it doesn’t work if declared as    ‘CustomProperties    Dim prps As Object    ‘Dim prps As Word.CustomProperties    Dim strDocsPath As String    Dim strTemplatePath As String        ‘Check that a letter has been selected.    strLetter = Nz(Me![cboLetters])    Set cbo = Me![cboLetters]    If strLetter = "" Then       cbo.SetFocus       cbo.Dropdown       GoTo ErrorHandlerExit    End If        ‘Check that a recipient has been selected.    strRecipient = Nz(Me![cboRecipients])    Set cbo = Me![cboRecipients]    If strRecipient = "" Then       cbo.SetFocus       cbo.Dropdown       GoTo ErrorHandlerExit    End If           Set gappWord = GetObject(, "Word.Application")    If CheckDocsDir = False Then       GoTo ErrorHandlerExit    End If    strDocsPath = GetDocsDir    strTemplatePath = TemplateDir    strLetter = strTemplatePath & strLetter    strLongDate = Format(Date, "mmmm d, yyyy")    strShortDate = Format(Date, "m-d-yyyy")        ‘Check for existence of template in template folder,    ‘and exit if not found    strTestFile = Nz(Dir(strLetter))    Debug.Print "Test file: " & strTestFile    If strTestFile = "" Then       MsgBox strLetter & " template not found; can’t create letter"       GoTo ErrorHandlerExit    End If        Set docs = gappWord.Documents    docs.Add strLetter    Set cbo = Me![cboRecipients] On Error Resume Next    ‘Assign values to many doc properties, so the same code can    ‘be used with different templates.    strName = Nz(cbo.Column(7))    strJobTitle = Nz(cbo.Column(10))    If strJobTitle <> "" Then       strNameAndJob = strName & vbCrLf & strJobTitle    Else       strNameAndJob = strName    End If        Set prps = gappWord.ActiveDocument.CustomDocumentProperties    prps.Item("TodayDate").Value = strLongDate    prps.Item("Name").Value = strNameAndJob    prps.Item("Address").Value = Nz(cbo.Column(8))    prps.Item("Street").Value = Nz(cbo.Column(2))    prps.Item("City").Value = Nz(cbo.Column(3))    prps.Item("State").Value = Nz(cbo.Column(4))    prps.Item("Zip").Value = Nz(cbo.Column(5))    prps.Item("Country").Value = Nz(cbo.Column(6))    prps.Item("CompanyName").Value = Nz(cbo.Column(9))    Debug.Print "Salutation: " & Nz(cbo.Column(11))    prps.Item("Salutation").Value = Nz(cbo.Column(11))    If InStr(strLetter, "Freestyle") > 0 Then       prps.Item("LetterText").Value = Nz(Me![txtLetterText])    End If     On Error GoTo ErrorHandlerExit    ‘Check for existence of previously saved letter in documents folder,    ‘and append an incremented number to save name if found    strDocType =        gappWord.ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)    strSaveName = strDocType & " to " & strName    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 " &              strName          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 save it    With gappWord       .Selection.WholeStory       .Selection.Fields.Update       .Selection.HomeKey Unit:=wdStory       .ActiveDocument.SaveAs strSaveName       .Visible = True       .ActiveWindow.WindowState = wdWindowStateNormal       .Activate    End With        ErrorHandlerExit:    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject.       Set gappWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

A letter created by this code is shown in Figure 11.12.

Figure 11.12

If you choose the Freestyle letter, any text you type into the txtLetterText textbox will be printed on the letter; this option is handy for quick notes. The third option, One-up Label, creates a single label for the selected recipient. This is a type of label that prints on a form that is the same size as a U.S. #10 envelope; it is handy when you need to print a single label, and don’t want to waste a whole sheet of labels.

Other Forms

There are several other forms in the database that do different types of mail merges, going beyond the simple letter to one recipient selection available on the main menu.

MultiSelect Listbox Form

Often you will need to do a mail merge to multiple recipients—but not necessarily all the records in a table or query. Access offers a special type of control that is very handy for this purpose—the MultiSelect listbox. To create a MultiSelect listbox, place a listbox on a form, open its properties sheet, select the Other tab, and set its Multiselect property to either Simple or Extended. The Simple setting only supports selection with the mouse or spacebar; the Extended selection (generally the best selection) lets you select multiple items with Ctrl-click and Shift-click, the same as making a selection in an Explorer pane.

frmExportToWordListBox has two comboboxes, for selecting a merge type (with more choices than on the main menu) and a Word template, and a MultiSelect listbox that is dynamically assigned a row source depending on your selection in the cboSelectTemplate combobox. The code for cboSelectMergeType’s AfterUpdate event follows (stripped of its standard error handler); it simply clears the row source of the other combobox and the listbox and requeries the other combobox.

Private Sub cboSelectMergeType_AfterUpdate()    Me![cboSelectTemplate].Value = Null    Me![cboSelectTemplate].Requery    Me![lstSelectMultiple].RowSource = “” End Sub

The cboSelectTemplate combobox’s AfterUpdate event procedure follows (also stripped of its error handler). This code picks up the template name and data source from cboSelectTemplate, enables (or disables) txtLetterText, depending on whether the template contains the word “Freestyle,” assigns the appropriate row source to the listbox, and sets its column properties to 3 equal-sized columns for a Catalog merge and 12 columns of different sizes for other merge documents.

 Private Sub cboSelectTemplate_AfterUpdate()    Dim strDataSource As String    Dim strTemplate As String    Set lst = Me![lstSelectMultiple]    strTemplate = Me![cboSelectTemplate].Column(1)    strDataSource = Me![cboSelectTemplate].Column(2)    lst.RowSource = strDataSource    If InStr(strTemplate, "Freestyle") > 0 Then       Me![txtLetterText].Enabled = True    Else       Me![txtLetterText].Enabled = False    End If    If InStr(strTemplate, "Catalog") > 0 Then       lst.ColumnWidths = ""       lst.ColumnCount = 3    Else       lst.ColumnWidths = -          "0 in;1.25 in;1.25 in;1 in;.6 in;.6 in;0 in;0 in;0 in;0 in;0 in;0 in"       lst.ColumnCount = 12    End If End Sub 

Figure 11.13 shows the listbox form, with the Bookmarks merge type, Freestyle contact letter, and all recipients selected (using the Select All button). Clicking the Create Document(s) button generates a set of separate documents to all 500 recipients (don’t do this unless you have lots of memory and disk space!).

Figure 11.13

There is a textbox on the main menu that displays the Documents path (default: C:\My Documents or C:\Documents and Settings\LogonName\My Documents, depending on your operating system); this information is stored in tblInfo. Before running merge code, check that the correct path is displayed, and edit it if needed. (See Figure 11.11 earlier for a view of the Docs Path textbox.)

The cmdCreateDocuments_Click event procedure follows, with interspersed explanatory text.

 Private Sub cmdCreateDocuments_Click() On Error GoTo ErrorHandler        Dim blnSomeSkipped As Boolean    Dim cbo As Access.ComboBox    Dim dbs As DAO.Database    Dim i As String    Dim intMergeType As Integer    Dim intSaveNameFail As String    Dim lngContactID As Long    Dim prps As Object    Dim rst As DAO.Recordset    Dim strAddress As String    Dim strCompanyName As String    Dim strCountry As String    Dim strDocName As String    Dim strDocsPath As String    Dim strDocType As String    Dim strEnvelopeAddress As String    Dim strEnvelopeName As String    Dim strFile As String    Dim strJobTitle As String    Dim strLetterText As String    Dim strLongDate As String    Dim strName As String    Dim strNameAndJob As String    Dim strPrompt As String    Dim strSalutation As String    Dim strSaveName As String    Dim strSaveNamePath As String    Dim strShortDate As String    Dim strSQL As String    Dim strTable As String    Dim strTemplatePath As String    Dim strTest As String    Dim strTestFile As String    Dim strTextFile As String    Dim strTitle As String    Dim strWordTemplate As String    Dim varItem As Variant     

This starts like the single letter, checking that a letter and at least one recipient have been selected.

    Set cbo = Me![cboSelectTemplate]    Set lst = Me![lstSelectMultiple]    strWordTemplate = Nz(cbo.Column(1))    Debug.Print "Selected template: " & strWordTemplate    If strWordTemplate = "" Then       MsgBox "Please select a document"       cbo.SetFocus       cbo.Dropdown       GoTo ErrorHandlerExit    Else       intMergeType = cbo.Column(3)       Debug.Print "Merge type: " & intMergeType    End If        ‘Check that at least one contact has been selected.    If lst.ItemsSelected.Count = 0 Then       MsgBox "Please select at least one contact"       lst.SetFocus       GoTo ErrorHandlerExit    Else       intColumns = lst.ColumnCount       intRows = lst.ItemsSelected.Count    End If 

Set up Word application variable and other variables to reference the Access Merge subfolder under the Documents and Templates folders and the current date in different formats.

    ‘Set Word application variable; if Word is not running,    ‘the error handler defaults to CreateObject    Set gappWord = GetObject(, "Word.Application")        ‘Set date and folder reference variables.    strLongDate = Format(Date, "mmmm d, yyyy")    strShortDate = Format(Date, "m-d-yyyy")    If CheckDocsDir = False Then       GoTo ErrorHandlerExit    End If    strDocsPath = GetDocsDir    strTemplatePath = TemplateDir    strWordTemplate = strTemplatePath & strWordTemplate    strLetterText = Nz(Me![LetterText]) 

Check for the existence of template in template folder, and exit if not found.

    strTestFile = Nz(Dir(strWordTemplate))    Debug.Print "Test file: " & strTestFile    If strTestFile = "" Then       MsgBox strWordTemplate & " template not found; can’t create document"       GoTo ErrorHandlerExit    End If 

Open a text file that will be filled with information about any records skipped because they were missing required name or address data.

    strFile = strDocsPath & "Skipped Records.txt"    Open strFile For Output As #1    Print #1, "These records were skipped when creating documents."    Print #1, 

Set up a Select Case statement that processes each merge type separately, based on the merge type selected in cboMergeType.

    Select Case intMergeType           Case 1          ‘Bookmarks          blnSomeSkipped = False 

Work with the ItemsSelected collection of the listbox, which represents the items that the user has selected. The value for each field is picked up from the appropriate column of a row in the listbox, iterating through all the selected rows.

          For Each varItem In lst.ItemsSelected             ‘Get Contact ID for reference             lngContactID = Nz(lst.Column(0, varItem))             Debug.Print "Contact ID: " & lngContactID 

Check for required information in various fields and skip to the next record (and write the Contact ID to the text file) in case anything is missing.

             ‘Check for required address information.             strTest = Nz(lst.Column(2, varItem))             Debug.Print "Street address: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No street address for Contact " & lngContactID                GoTo NextItem1             End If                          strTest = Nz(lst.Column(3, varItem))             Debug.Print "City: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No city for Contact " & lngContactID                GoTo NextItem1             End If                          strTest = Nz(lst.Column(5, varItem))             Debug.Print "Postal code: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No postal code for Contact " & lngContactID                GoTo NextItem1             End If                       strName = Nz(lst.Column(7, varItem))             strJobTitle = Nz(lst.Column(10, varItem))             If strJobTitle <> "" Then                strNameAndJob = strName & vbCrLf & strJobTitle             Else                strNameAndJob = strName             End If             strAddress = Nz(lst.Column(8, varItem))             Debug.Print "Address: " & strAddress             strCountry = Nz(lst.Column(6, varItem))             If strCountry <> "USA" Then                strAddress = strAddress & vbCrLf & strCountry             End If             strCompanyName = Nz(lst.Column(9, varItem))             strSalutation = Nz(lst.Column(11, varItem))                          ‘Open a new document based on the selected template.             gappWord.Documents.Add strWordTemplate 

The following writes information to bookmarks in the Word document. All bookmarks that exist in any of the templates are included, with an On Error Resume Next statement to prevent errors from missing bookmarks, and If . . . Then statements for special cases (the bookmark exists, but should only be filled for certain documents).

 On Error Resume Next             With gappWord.Selection                .GoTo What:=wdGoToBookmark, Name:="Name"                .TypeText Text:=strName               .GoTo What:=wdGoToBookmark, Name:="CompanyName"                If Left(cbo.Value, 12) <> "One-up Label" Then                   .TypeText Text:=strCompanyName                End If                .GoTo What:=wdGoToBookmark, Name:="Address"                .TypeText Text:=strAddress                .GoTo What:=wdGoToBookmark, Name:="Salutation"                If Left(cbo.Value, 12) <> "One-up Label" Then                   .TypeText Text:=strSalutation                End If                .GoTo What:=wdGoToBookmark, Name:="TodayDate"                If Left(cbo.Value, 12) <> "One-up Label" Then                   .TypeText Text:=strLongDate                End If                .GoTo What:=wdGoToBookmark, Name:="EnvelopeName"                If Left(cbo.Value, 12) <> "One-up Label" Then                   .TypeText Text:=strName                End If                .GoTo What:=wdGoToBookmark, Name:="EnvelopeCompany"                If Left(cbo.Value, 12) <> "One-up Label" Then                   .TypeText Text:=strCompanyName                End If                .GoTo What:=wdGoToBookmark, Name:="EnvelopeAddress"                If Left(cbo.Value, 12) <> "One-up Label" Then                   .TypeText Text:=strAddress                End If                .GoTo What:=wdGoToBookmark, Name:="LetterText"                If Left(cbo.Column(1), 9) = "Freestyle" Then                   .TypeText Text:=strLetterText                End If             End With 

A save name is created (the same as for the single document).

 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 =                 gappWord.ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)             strSaveName = strDocType & " to " & strName             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 " & strName                   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 

Word fields are updated and the document is saved.

             ‘Update fields in Word document and save it             With gappWord                .Selection.WholeStory                .Selection.Fields.Update                .Selection.HomeKey Unit:=wdStory                .ActiveDocument.SaveAs strSaveNamePath                .Visible = True                .ActiveWindow.WindowState = wdWindowStateNormal                .Activate             End With              NextItem1: 

Proceed to the next item in the ItemsSelected collection.

          Next varItem 

Generate a “Merge done” message, with info about text file if some records have been skipped.

          strTitle = "Merge done"          If blnSomeSkipped = True Then             strPrompt = "All documents created; some records skipped because "                 & "of missing information." & vbCrLf & "See " & strDocsPath                 & "Skipped Records.txt for details."          Else             strPrompt = "All documents created!"          End If                       MsgBox strPrompt, vbOKOnly + vbInformation, strTitle                 Case 2 

The first portion of code is the same as for the Bookmarks case.

          ‘Doc Properties          blnSomeSkipped = False                    For Each varItem In lst.ItemsSelected             ‘Get Contact ID for reference             lngContactID = Nz(lst.Column(0, varItem))             Debug.Print "Contact ID: " & lngContactID                          ‘Check for required address information             strTest = Nz(lst.Column(2, varItem))             Debug.Print "Street address: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No street address for Contact " & lngContactID                GoTo NextItem2             End If                          strTest = Nz(lst.Column(3, varItem))             Debug.Print "City: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No city for Contact " & lngContactID                GoTo NextItem2             End If                          strTest = Nz(lst.Column(5, varItem))             Debug.Print "Postal code: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No postal code for Contact " & lngContactID                GoTo NextItem2             End If                       strName = Nz(lst.Column(7, varItem))             strJobTitle = Nz(lst.Column(10, varItem))             If strJobTitle <> "" Then                strNameAndJob = strName & vbCrLf & strJobTitle             Else                strNameAndJob = strName             End If             strAddress = Nz(lst.Column(8, varItem))             Debug.Print "Address: " & strAddress             strCountry = Nz(lst.Column(6, varItem))             If strCountry <> "USA" Then                strAddress = strAddress & vbCrLf & strCountry             End If             strCompanyName = Nz(lst.Column(9, varItem))             strSalutation = Nz(lst.Column(11, varItem))                          ‘Open a new letter based on the selected template.             gappWord.Documents.Add strWordTemplate 

Instead of using bookmarks, the information is written to Word doc properties, with an On Error Resume Next statement because not all doc properties exist in all the templates.

             ‘Write information to Word custom document properties             Set prps = gappWord.ActiveDocument.CustomDocumentProperties             prps.Item("Name").Value = strName On Error Resume Next             With prps                .Item("Salutation").Value = strSalutation                .Item("CompanyName").Value = strCompanyName                .Item("Address").Value = strAddress                .Item("TodayDate").Value = strLongDate                .Item("LetterText").Value = strLetterText             End With 

The document is saved and updated similarly to the Bookmarks case.

 On Error GoTo ErrorHandler             ‘Check for existence of previously saved document in documents folder,             ‘and append an incremented number to save name if found             strDocType =                 gappWord.ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)             strSaveName = strDocType & " to " & strName             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 " & strName                   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 save it             With gappWord                .Selection.WholeStory                .Selection.Fields.Update                .Selection.HomeKey Unit:=wdStory                .ActiveDocument.SaveAs strSaveNamePath                .Visible = True                .ActiveWindow.WindowState = wdWindowStateNormal                .Activate             End With NextItem2:          Next varItem                    strTitle = "Merge done"          If blnSomeSkipped = True Then             strPrompt = "All documents created; some records skipped because "                 & "of missing information." & vbCrLf & "See " & strDocsPath                 & "Skipped Records.txt for details."          Else             strPrompt = "All documents created!"          End If                       MsgBox strPrompt, vbOKOnly + vbInformation, strTitle                 Case 3          ‘Mail Merge          blnSomeSkipped = False 

A table that holds the specific records to merge is cleared of old data, and a recordset based on it is opened.

          ‘Clear tblMergeList and set up recordset based on it          strTable = "tblMailMergeList"          strSQL = "DELETE tblMailMergeList.* FROM tblMailMergeList;"          DoCmd.SetWarnings False          DoCmd.RunSQL strSQL          Set dbs = CurrentDb          Debug.Print "Opening recordset based on " & strTable          Set rst = dbs.OpenRecordset(strTable, dbOpenTable) 

Records are checked for missing information, as in the Bookmarks case.

          For Each varItem In lst.ItemsSelected             ‘Get Contact ID for reference             lngContactID = Nz(lst.Column(0, varItem))             Debug.Print "Contact ID: " & lngContactID                          ‘Check for required address information.             strTest = Nz(lst.Column(2, varItem))             Debug.Print "Street address: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No street address for Contact " & lngContactID                GoTo NextItem3             End If                          strTest = Nz(lst.Column(3, varItem))             Debug.Print "City: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No city for Contact " & lngContactID                GoTo NextItem3             End If                          strTest = Nz(lst.Column(5, varItem))             Debug.Print "Postal code: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No postal code for Contact " & lngContactID                GoTo NextItem3             End If                       strName = Nz(lst.Column(7, varItem))             strJobTitle = Nz(lst.Column(10, varItem))             strAddress = Nz(lst.Column(8, varItem))             Debug.Print "Address: " & strAddress             strCountry = Nz(lst.Column(6, varItem))             If strCountry <> "USA" Then                strAddress = strAddress & vbCrLf & strCountry             End If             strCompanyName = Nz(lst.Column(9, varItem))             strSalutation = Nz(lst.Column(11, varItem)) 

The data from the current record is written to a new record in the tblMailMergeList table.

             ‘Write data from variables to a new record in table             With rst                .AddNew                !Name = strName                !JobTitle = strJobTitle                !CompanyName = strCompanyName                !Address = strAddress                !Salutation = strSalutation                !TodayDate = strLongDate                .Update             End With              NextItem3: 

Proceed to the next selected item.

          Next varItem          rst.Close 

The data in the filled tblMailMergeList table is exported to a text file. This file will be the data source of the Word mail merge document.

          ‘Export merge list to a text file          If CheckDocsDir = False Then             GoTo ErrorHandlerExit          End If          strDocsPath = GetDocsDir          Debug.Print "Docs path: " & strDocsPath          strTextFile = strDocsPath & "Mail Merge Data.txt"          Debug.Print "Text file for merge: " & strTextFile          DoCmd.TransferText transfertype:=acExportDelim, TableName:=strTable,              FileName:=strTextFile, HasFieldNames:=True 

A new document is created from the selected mail merge template.

          ‘Open a new merge document based on the selected template.          gappWord.Documents.Add strWordTemplate          strDocName = gappWord.ActiveDocument          Debug.Print "Initial doc name: " & strDocName 

A save name is created, based on the name in the template’s Subject property plus the date.

          ‘Check for existence of previously saved letter in documents folder,          ‘and append an incremented number to save name if found          strDocType =              gappWord.ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)          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 

The previously created text file is assigned as the merge document’s data source, the merge is performed, and the resulting document is saved and opened.

          With gappWord             .ActiveDocument.MailMerge.OpenDataSource Name:=strTextFile,                 Format:=wdOpenFormatText             .ActiveDocument.MailMerge.Destination = wdSendToNewDocument             .ActiveDocument.MailMerge.Execute             .ActiveDocument.SaveAs strSaveNamePath             .Documents(strDocName).Close SaveChanges:=wdDoNotSaveChanges             .Visible = True             .ActiveWindow.WindowState = wdWindowStateNormal             .Activate          End With 

A “Merge done” message pops up, with information on the text file if any records have been skipped.

          strTitle = "Merge done"          If blnSomeSkipped = True Then             strPrompt = "Merge document created; some records skipped because "                 & "of missing information." & vbCrLf & "See " & strDocsPath                 & "Skipped Records.txt for details."          Else             strPrompt = "Merge document created!"          End If                       MsgBox strPrompt, vbOKOnly + vbInformation, strTitle                    Case 4          ‘Catalog Merge          blnSomeSkipped = False 

The Catalog merge is very similar to mail merge; the only difference is in the appearance of the final document. A catalog merge document is a tabular document, with one record per row, rather than one record per page as in a mail merge document.

          ‘Clear tblCatalogMergeList and set up recordset based on it          strTable = "tblCatalogMergeList"          strSQL = "DELETE tblCatalogMergeList.* FROM tblCatalogMergeList;"          DoCmd.SetWarnings False          DoCmd.RunSQL strSQL          Set dbs = CurrentDb          Debug.Print "Opening recordset based on " & strTable          Set rst = dbs.OpenRecordset(strTable, dbOpenTable)                    For Each varItem In lst.ItemsSelected             ‘Write data from listbox to a new record in table             With rst                .AddNew                ![AuthorName] = Nz(lst.Column(0, varItem))                ![BookTitle] = Nz(lst.Column(1, varItem))                ![Category] = Nz(lst.Column(2, varItem))                .Update             End With              NextItem4:          Next varItem          rst.Close                    ‘Export merge list to a text file          ‘strDBPath = Application.CurrentProject.Path & "\"          If CheckDocsDir = False Then             GoTo ErrorHandlerExit          End If          strDocsPath = GetDocsDir          Debug.Print "Docs path: " & strDocsPath          strTextFile = strDocsPath & "Catalog Merge Data.txt"          Debug.Print "Text file for merge: " & strTextFile          DoCmd.TransferText transfertype:=acExportDelim, TableName:=strTable,              FileName:=strTextFile, HasFieldNames:=True                    ‘Open a new merge document based on the selected template.          gappWord.Documents.Add strWordTemplate          strDocName = gappWord.ActiveDocument          Debug.Print "Initial doc name: " & strDocName                    ‘Check for existence of previously saved letter in documents folder,          ‘and append an incremented number to save name if found          strDocType =              gappWord.ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)          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                    ‘Set the merge data source to the text file just created,          ‘and do the merge.          With gappWord             .ActiveDocument.MailMerge.OpenDataSource Name:=strTextFile,                 Format:=wdOpenFormatText             .ActiveDocument.MailMerge.Destination = wdSendToNewDocument             .ActiveDocument.MailMerge.Execute             .ActiveDocument.SaveAs strSaveNamePath             .Documents(strDocName).Close SaveChanges:=wdDoNotSaveChanges             .Visible = True             .ActiveWindow.WindowState = wdWindowStateNormal             .Activate          End With                    strTitle = "Merge done"          If blnSomeSkipped = True Then             strPrompt = "Merge document created; some records skipped because "                 & "of missing information." & vbCrLf & "See " & strDocsPath                 & "Skipped Records.txt for details."          Else             strPrompt = "Merge document created!"          End If                       MsgBox strPrompt, vbOKOnly + vbInformation, strTitle                 Case 5          ‘TypeText method          blnSomeSkipped = False 

The TypeText merge is similar to the Bookmarks and Doc Properties merges in the initial sections of code.

          ‘Open a new document based on the selected template.          gappWord.Documents.Add strWordTemplate                 For Each varItem In lst.ItemsSelected             ‘Write info from contact item to variables             ‘Get Contact ID for reference             lngContactID = Nz(lst.Column(0, varItem))             Debug.Print "Contact ID: " & lngContactID                          ‘Check for required address information             strTest = Nz(lst.Column(2, varItem))             Debug.Print "Street address: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No street address for Contact " & lngContactID                GoTo NextItem5             End If                          strTest = Nz(lst.Column(3, varItem))             Debug.Print "City: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No city for Contact " & lngContactID                GoTo NextItem5             End If                          strTest = Nz(lst.Column(5, varItem))             Debug.Print "Postal code: " & strTest             If strTest = "" Then                blnSomeSkipped = True                Print #1,                Print #1, "No postal code for Contact " & lngContactID                GoTo NextItem5             End If                       strName = Nz(lst.Column(7, varItem))             strJobTitle = Nz(lst.Column(10, varItem))             If strJobTitle <> "" Then                strName = strName & vbCrLf & strJobTitle             End If                          strAddress = Nz(lst.Column(8, varItem))             Debug.Print "Address: " & strAddress             strCountry = Nz(lst.Column(6, varItem))             If strCountry <> "USA" Then                strAddress = strAddress & vbCrLf & strCountry             End If             strCompanyName = Nz(lst.Column(9, varItem))             strSalutation = Nz(lst.Column(11, varItem)) 

Insert data directly into a cell in the table of the selected labels document.

             ‘Insert data into labels             With gappWord                .Selection.TypeText Text:=strName                .Selection.TypeParagraph                .Selection.TypeText Text:=strCompanyName                .Selection.TypeParagraph                .Selection.TypeText Text:=strAddress                .Selection.TypeParagraph                .Selection.MoveRight Unit:=wdCell             End With              NextItem5:          Next varItem                    ‘Check for existence of previously saved document in documents folder,          ‘and append an incremented number to save name if found          strDocType =              gappWord.ActiveDocument.BuiltInDocumentProperties(wdPropertySubject)          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 gappWord             .Selection.HomeKey Unit:=wdStory             .ActiveDocument.SaveAs strSaveNamePath             .Visible = True             .ActiveWindow.WindowState = wdWindowStateNormal             .Activate          End With                    strTitle = "Merge done"          If blnSomeSkipped = True Then             strPrompt = "Merge document created; some records skipped because "                 & "of missing information." & vbCrLf & "See " & strDocsPath                 & "Skipped Records.txt for details."          Else             strPrompt = "Merge document created!"          End If                       MsgBox strPrompt, vbOKOnly + vbInformation, strTitle              End Select     ErrorHandlerExit:    Close #1    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject.       Set gappWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

Figure 11.14 shows the Ebook Catalog merge document selected, and books by David Weber selected in the listbox (for this selection, the listbox is filled with book data instead of contact data).

Figure 11.14

The resulting Catalog Merge document is shown in Figure 11.15.

Figure 11.15

The Catalog Merge type is rather flaky, compared to regular mail merge. In Word 2000, there is a bug that places each record on its own page. In Word 2002 and 2003, that bug is gone, but catalog merges are very prone to crashing Word (though, after recovering from the crash, the catalog merge document is usually there).

Datasheet Form

After working with the listbox form for selecting multiple recipients, you may realize that it has some limitations. It is easy to select all recipients for a letter or document, or just a few recipients chosen on an ad hoc basis, but it isn’t easy to select large numbers of recipients based on the value of a field—for example, sending a letter to all the recipients in the state of Ohio, or printing an ebook catalog for books in the Alternate History category. There is no way to do this kind of selection in a listbox, so I made another form, with a datasheet subform, to make it possible to select recipients using a filter based on a field value. frmExportToWordDatasheet is shown in its initial state in Figure 11.16.

Figure 11.16

Occasionally, when working with Automation code, you will get the error message “Error No. 462: The remote server machine does not exist or is unavailable.” This means that the Automation client has lost contact with the Automation server. When this happens, close the database and reopen it to get a fresh connection.

The header of this form has comboboxes for selecting the merge type and template. After you make your selections, a datasheet subform becomes visible, listing either contact or book data (depending on the selected template). Additionally, several other controls for sorting and filtering data are enabled. The Records option group lets you select to merge all or filtered records (by default, All is selected). If you leave All selected, all the records from the underlying query are displayed in the datasheet subform. If you select the Filtered Records option, the Filter field combobox is enabled, so you can select a field for filtering. On selecting a field, its values are displayed in the Filter Value combobox. When you select a filter value, the filtered records are displayed in the datasheet.

You can also sort the data in the datasheet by clicking the column heading and then clicking the Sort Ascending (or Sort Descending) button on the database toolbar. Sorting the data makes it easy to see (for example) whether there are any contacts in a specific state.

When the datasheet displays all data, it is locked (to prevent alteration of the data). When it is filtered, the datasheet is bound to a temporary table created in code, and in that case the datasheet is editable, so you can (if desired) delete records you don’t want to merge, without modifying the underlying data in the tables. Figure 11.17 shows the datasheet form with the TypeText merge selected, the Avery 5161 Labels document, and a filter for the state of Alaska.

Figure 11.17

The resulting labels document is shown in Figure 11.18.

Figure 11.18

The code on the cboSelectTemplate combobox (stripped of its standard error handler) follows. After setting variables with values picked up from the combobox, and a public variable (pstrDataDype) that is set from the selection in the other combobox, the code makes either the subContacts or the subEBookCatalog datasheet visible, and the other one invisible. If the subContacts datasheet is visible,_it is locked so that data in it can’t be modified.

Next, the filter comboboxes are cleared, and the cboFilterField combobox is assigned the appropriate query as its data source, depending on the selected template. Finally, txtLetterText is enabled only if a freestyle template has been selected.

 Private Sub cboSelectTemplate_AfterUpdate() On Error GoTo ErrorHandler        Dim strDataSource As String    Dim strTemplate As String        strTemplate = Me![cboSelectTemplate].Column(1)    strDataSource = Me![cboSelectTemplate].Column(2)    pstrDataType = Me![cboSelectTemplate].Column(4)    Debug.Print "Data type: " & pstrDataType    pstrQuery = strDataSource    If pstrDataType = "C" Then       Me![subContacts].Visible = True       Me![subContacts].Locked = True       Me![subEBookCatalog].Visible = False    ElseIf pstrDataType = "E" Then       Me![subContacts].Visible = False       Me![subEBookCatalog].Visible = True    End If        Me![cboFilterField].Value = Null    Me![cboFilterValue].Value = Null    Me![cboFilterField].RowSource = pstrQuery & "Alpha"    Me![fraRecords].Enabled = True        If InStr(strTemplate, "Freestyle") > 0 Then       Me![txtLetterText].Enabled = True    Else       Me![txtLetterText].Enabled = False    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

The AfterUpdate event procedures for the two filter fields follow with explanatory text.

 Private Sub cboFilterField_AfterUpdate() On Error GoTo ErrorHandler 

Set a public variable representing the filter field if one has been selected; otherwise exit the procedure with an error message.

    pstrFilterField = Nz(Me![cboFilterField].Value)    If pstrFilterField = "" Then       strTitle = "No field selected"       strPrompt = "Please select a field for filtering"       MsgBox strPrompt, vbCritical + vbOKOnly, strTitle       Me![cboFilterField].SetFocus       GoTo ErrorHandlerExit    End If 

Set the strQuery variable to the appropriate query (contacts or books data).

    If pstrDataType = "C" Then       strQuery = "qryContactsAlpha"    ElseIf pstrDataType = "E" Then       strQuery = "qryEBookCatalogAlpha"    End If 

Create a SQL statement for the non-null values of the selected field, and assign it as the row source of cboFilterValue, for selecting values. Finally, delete the old make-table query and its table, if they exist.

    strSQL = "SELECT DISTINCT " & strQuery & ".[" & pstrFilterField &        "] FROM " & strQuery & " WHERE [" & pstrFilterField & "] Is Not Null;"    Debug.Print "SQL string: " & strSQL    With Me![cboFilterValue]       .Value = Null       .RowSource = strSQL       .Requery       .Enabled = True       .SetFocus       .Dropdown    End With    Me![txtFilterString].Value = Null    CallClearTables ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub Private Sub cboFilterValue_AfterUpdate() On Error GoTo ErrorHandler    Dim intDataType As Integer    Dim fld As DAO.Field    Dim qdf As DAO.QueryDef    Dim strTotalsQuery As String    Dim strLinkedQuery As String    Dim strFilter As String 

Set a public variant variable to the selected value (I use the Variant data type because the value could be of different data types depending on the field).

    pvarFilterValue = Me![cboFilterValue].Value        ‘Determine data type of selected field    Set dbs = CurrentDb    Set rst = dbs.OpenRecordset(pstrQuery, dbOpenDynaset)    Set fld = rst.Fields(pstrFilterField)    intDataType = fld.Type    Debug.Print "Field data type: " & intDataType 

Create an appropriate filter string according to the data type of the selected field value.

    Select Case intDataType       Case 1          ‘Boolean          strFilter = "[" & pstrFilterField & "] = " & pvarFilterValue              Case 2, 3, 4, 6, 7          ‘Various numeric          strFilter = "[" & pstrFilterField & "] = " & pvarFilterValue                 Case 5          ‘Currency          strFilter = "[" & pstrFilterField & "] = " & CCur(pvarFilterValue)                 Case 8          ‘Date          strFilter = "[" & pstrFilterField & "] = " & Chr$(35)              & pvarFilterValue & Chr$(35)                 Case 10          ‘Text          strFilter = "[" & pstrFilterField & "] = " & Chr$(34)              & pvarFilterValue & Chr$(34)       Case 11, 12, 15          ‘OLE object, Memo, Replication ID          strPrompt = "Can’t filter by this field; please select another field"          MsgBox strPrompt, vbCritical + vbOKOnly          Me![cboFilterValue].SetFocus          Me![cboFilterValue].Dropdown          GoTo ErrorHandlerExit              End Select        Debug.Print "Filter string: " & strFilter 

Apply the filter to the record source and make a table from it.

    Me![txtFilterString] = strFilter    strQuery = "qmakMatchingRecords"    strSQL = "SELECT " & pstrQuery & ".* INTO tmakMatchingRecords "        & "FROM " & pstrQuery & " WHERE " & strFilter & ";"    Debug.Print "SQL Statement: " & strSQL    Set qdf = dbs.CreateQueryDef(strQuery, strSQL)    qdf.Execute    Me![cboFilterField].Value = Null    Me![cboFilterValue].Value = Null 

Depending on the data type, assign the filtered subform as a source object to the appropriate datasheet subform.

    If pstrDataType = "C" Then       Me![subContacts].SourceObject = "fsubContactsFiltered"       Debug.Print "subContacts source object: "           & Me![subContacts].SourceObject    ElseIf pstrDataType = "E" Then       Me![subEBookCatalog].SourceObject = "fsubEBookCatalogFiltered"       Debug.Print "subEBookCatalog source object: "           & Me![subEBookCatalog].SourceObject    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

The cmdCreateDocuments code is very similar to the code on the listbox form. The only difference is that instead of picking up selected data from rows and columns in the listbox, the code picks up values from a recordset: qryContacts or qryEBookCatalog if all records are to be merged, or tmakMatchingRecords (a table created by a make-table query) for filtered data. A portion of the code showing the recordset creation and the beginning of the Bookmarks case follows.

    ‘Determine whether it is a Contacts or EBook merge, and whether all    ‘records or filtered records are to be merged.    If Me![fraRecords].Value = 1 Then       ‘All records       If pstrDataType = "C" Then          strDataSource = "qryContacts"       ElseIf pstrDataType = "E" Then          strDataSource = "qryEBookCatalog"       End If    ElseIf Me![fraRecords].Value = 2 Then       ‘Filtered records       strDataSource = "tmakMatchingRecords"    End If        Set dbs = CurrentDb    Set rstData = dbs.OpenRecordset(strDataSource, dbOpenDynaset)        Select Case intMergeType           Case 1          ‘Bookmarks          blnSomeSkipped = False              With rstData             Do While Not .EOF                ‘Get Contact ID for reference                lngContactID = Nz(![ContactID])                Debug.Print "Contact ID: " & lngContactID                                ‘Check for required address information                strTest = Nz(![StreetAddress])                Debug.Print "Street address: " & strTest                If strTest = "" Then                   blnSomeSkipped = True                   Print #1,                   Print #1, "No street address for Contact " & lngContactID                   GoTo NextItem1                End If 

Invoice Creation Dialog

The last example of exporting Access data to Word illustrates exporting data from linked tables. The target is an invoice document (similar to the Northwind invoice report in the sample Northwind database that comes with Access). The invoice needs information from a customer record in the main body of the invoice, and a list of as many items as needed (the invoice details). The data for the invoice comes from several Northwind tables (given appropriate LNC tags). The form (shown in Figure 11.19) is very simple: a small dialog that lets you select the order from a combobox that displays the order number, company name, and the date when its list is dropped down (this information is displayed in the locked blue textboxes).

I use a convention of giving locked controls a light blue background to tell users that they can’t modify data in these controls.

Figure 11.19

The Create Invoice button’s Click event procedure follows with explanatory text.

 Private Sub cmdCreateInvoice_Click() On Error GoTo ErrorHandler    Dim dbs As DAO.Database    Dim docs As Word.Documents    Dim prps As Object    Dim rst As DAO.Recordset    Dim blnSaveNameFail As Boolean    Dim lngOrderID As Long    Dim strShipName As String    Dim strShipAddress As String    Dim strShipCityStateZip As String    Dim strShipCountry As String    Dim strCustomerID As String    Dim strCompanyName As String    Dim strBillToAddress As String    Dim strBillToCityStateZip As String    Dim strBillToCountry As String    Dim strSalesperson As String    Dim dteTodayDate As Date    Dim dteOrderDate As Date    Dim dteRequiredDate As Date    Dim dteShippedDate As Date    Dim strShipper As String    Dim curSubtotal As Currency    Dim curFreight As Currency    Dim curTotal As Currency    Dim lngProductID As Long    Dim strProductName As String    Dim dblQuantity As Double    Dim strUnitPrice As String    Dim strDiscount As String    Dim strExtendedPrice As String    Dim strDoc As String    Dim strDocsPath As String    Dim strSaveName As String    Dim strSaveNamePath As String    Dim strShortDate As String    Dim strTemplatePath As String    Dim strTest As String    Dim strTestFile As String    Dim strWordTemplate As String    Dim strMessageTitle As String    Dim strMessage As String    Dim intReturn As Integer    Dim intCount As Integer 

Run make-table queries to create tables to use for export. I use make-table queries instead of select queries, because the queries have a criterion limiting the Order ID to the one selected on the form, and such parameter queries can’t be used in a recordset. Instead, the code runs make-table queries to create tables, which will be used in the recordsets later in the procedure.

    DoCmd.SetWarnings False    DoCmd.OpenQuery "qmakInvoice"    DoCmd.OpenQuery "qmakInvoiceDetails" 

Check that there is at least one detail item before creating invoice.

    intCount = DCount("*", "tmakInvoiceDetails")    Debug.Print "Number of Detail items: " & intCount        If intCount < 1 Then       MsgBox "No detail items for invoice; canceling"       GoTo ErrorHandlerExit    End If 

Create a recordset based on the table of invoice data, and assign variables to be used to set doc properties for this invoice from the table.

    Set dbs = CurrentDb    Set rst = dbs.OpenRecordset("tmakInvoice", dbOpenDynaset)    With rst 

The Nz function is used to convert any Nulls to zeros or zero-length strings, to prevent problems with exporting to Word doc properties.

       lngOrderID = Nz(![OrderID])       Debug.Print "Order ID: " & lngOrderID       strShipName = Nz(![ShipName])       strShipAddress = Nz(![ShipAddress])       strShipCityStateZip = Nz(![ShipCityStateZip])       strShipCountry = Nz(![ShipCountry])       strCompanyName = Nz(![CompanyName])       strCustomerID = Nz(![CustomerID])       strCompanyName = Nz(![CompanyName])       strBillToAddress = Nz(![BillToAddress])       strBillToCityStateZip = Nz(![BillToCityStateZip])       strBillToCountry = Nz(![BillToCountry])       strSalesperson = Nz(![Salesperson])       dteOrderDate = Nz(![OrderDate])       dteRequiredDate = Nz(![RequiredDate])       dteShippedDate = Nz(![ShippedDate])       strShipper = Nz(![Shipper])       curSubtotal = Nz(![Subtotal])       curFreight = Nz(![Freight])       curTotal = Nz(![Total])    End With    rst.Close        Set gappWord = GetObject(, "Word.Application")    If CheckDocsDir = False Then       GoTo ErrorHandlerExit    End If    strDocsPath = GetDocsDir    strTemplatePath = TemplateDir    strWordTemplate = strTemplatePath & "Northwind Invoice.dot" 

Check for the existence of the selected template in the template folder, and exit if it is not found.

    strTestFile = Nz(Dir(strWordTemplate))    Debug.Print "Test file: " & strTestFile    If strTestFile = "" Then       MsgBox strWordTemplate & " template not found; can’t create invoice"       GoTo ErrorHandlerExit    End If 

This date string is used in creating the invoice’s save name; I use a date format with dashes to prevent problems when creating a save name for the document later on.

    strShortDate = Format(Date, "m-d-yyyy") 

This date variable is used to print the current day’s date on the invoice (unlike a Word date code, it remains stable when the invoice is reopened later).

    dteTodayDate = Date        Set docs = gappWord.Documents    docs.Add strWordTemplate 

Write information to Word custom document properties from previously created variables. There is no need for an On Error Resume Next statement before this block of code in this procedure, because it writes data to only one template, which has all the required doc properties.

    Set prps = gappWord.ActiveDocument.CustomDocumentProperties    With prps       .Item("TodayDate").Value = dteTodayDate       .Item("OrderID").Value = lngOrderID       .Item("ShipName").Value = strShipName       .Item("ShipAddress").Value = strShipAddress       .Item("ShipCityStateZip").Value = strShipCityStateZip       .Item("ShipCountry").Value = strShipCountry       .Item("CompanyName").Value = strCompanyName       .Item("CustomerID").Value = strCustomerID       .Item("CompanyName").Value = strCompanyName       .Item("BillToAddress").Value = strBillToAddress       .Item("BillToCityStateZip").Value = strBillToCityStateZip       .Item("BillToCountry").Value = strBillToCountry       .Item("Salesperson").Value = strSalesperson       .Item("OrderDate").Value = dteOrderDate       .Item("RequiredDate").Value = dteRequiredDate       .Item("ShippedDate").Value = dteShippedDate       .Item("Shipper").Value = strShipper       .Item("Subtotal").Value = curSubtotal       .Item("Freight").Value = curFreight       .Item("Total").Value = curTotal    End With 

Highlight the entire Word document and update fields so that the data written to the custom doc props is displayed in the DocProperty fields.

    With gappWord       .Selection.WholeStory       .Selection.Fields.Update       .Selection.HomeKey Unit:=wdStory       .Visible = True       .Activate    End With 

Go to the table in the invoice document, and fill it with Details data from the recordset of linked Details data.

    With gappWord.Selection       .GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=3, Name:=""       .MoveDown Unit:=wdLine, Count:=1    End With 

Set up a recordset of linked Details data to put into the table on the Word invoice.

    Set rst = dbs.OpenRecordset("tmakInvoiceDetails", dbOpenDynaset) 

Save Details information to variables, using the Format function to apply the appropriate formatting to Currency and Percent fields, because they don’t keep their Access formatting when assigned to Word numeric doc properties.

    With rst       .MoveFirst       Do While Not .EOF          lngProductID = Nz(![ProductID])          Debug.Print "Product ID: " & lngProductID          strProductName = Nz(![ProductName])          Debug.Print "Product Name: " & strProductName          dblQuantity = Nz(![Quantity])          Debug.Print "Quantity: " & dblQuantity          strUnitPrice = Format(Nz(![UnitPrice]), "$##.00")          Debug.Print "Unit price: " & strUnitPrice          strDiscount = Format(Nz(![Discount]), "0%")          Debug.Print "Discount: " & strDiscount          strExtendedPrice = Format(Nz(![ExtendedPrice]), "$#,###.00")          Debug.Print "Extended price: " & strExtendedPrice Move through the table, writing values from the variables to cells in the Word table.          With gappWord.Selection             .TypeText Text:=CStr(lngProductID)             .MoveRight Unit:=wdCell             .TypeText Text:=strProductName             .MoveRight Unit:=wdCell             .TypeText Text:=CStr(dblQuantity)             .MoveRight Unit:=wdCell             .TypeText Text:=strUnitPrice             .MoveRight Unit:=wdCell             .TypeText Text:=strDiscount             .MoveRight Unit:=wdCell             .TypeText Text:=strExtendedPrice             .MoveRight Unit:=wdCell          End With          .MoveNext       Loop       .Close    End With    dbs.Close 

Delete the last, empty row of the table.

    Selection.SelectRow    Selection.Rows.Delete 

Check for the existence of a previously saved letter in documents folder, and append an incremented number to the save name if found.

    strSaveName = "Invoice to " & strCompanyName & " for Order "        & lngOrderID & " on " & strShortDate & ".doc"         intCount = 2    blnSaveNameFail = True    Do While blnSaveNameFail       strSaveNamePath = strDocsPath & strSaveName       Debug.Print "Proposed save name and path: "           & vbCrLf & strSaveNamePath       strTestFile = Nz(Dir(strSaveNamePath))       If strTestFile = strSaveName Then                    ‘Create new save name with incremented number          blnSaveNameFail = True        strSaveName = "Invoice " & CStr(intCount) & " to " & strCompanyName         & " for Order " & lngOrderID & " on " & strShortDate & ".doc"          strSaveNamePath = strDocsPath & strSaveName          intCount = intCount + 1       Else          blnSaveNameFail = False       End If    Loop 

Save the document with the save name just created.

    gappWord.ActiveDocument.SaveAs strSaveNamePath     ErrorHandlerExit:    ‘Close any open recordset or database, in case code stops because    ‘of an error    On Error Resume Next    rst.Close    dbs.Close    Exit Sub ErrorHandler:    If Err = 429 Then       ‘Word is not running; open Word with CreateObject.       Set gappWord = CreateObject("Word.Application")       Resume Next    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If     End Sub 

An invoice document created from this code is shown in Figure 11.20.

Figure 11.20