Sending a Word Letter to Multiple Access Contacts

When you need to select a group of recipients for a Word letter, set of labels, or another document, you need a different interface. The form frmMergeToWord has a combo box for selecting a Word template, and a multi-select ListBox for selecting one or more contacts as recipients (see Figure 6.17).


A form for selecting a document and recipients for creating Word documents filled with Access data from multiple contact records.


The Select Document combo box list shows the merge type in the second column (see Figure 6.18).

The procedure on the cmdMerge buttons Click event first determines that a template has been selected, and that the template can be found in the Contact Templates folder (this folder is set on the database's main menu). Next, the merge method is picked up from the third column of the combo box's list (the first column is not displayed; it contains the file name of the selected document, for use in code).

Because some of the merge documents are Word documents, and some are templates, and some are in Word 2007 format and others in Word 97/2003 format, there is an If...Then statement in the procedure that examines the original document's extension, and creates the appropriate save document extension for use as an argument for the called procedures.


A combo box for selecting a Word template for merging data from Access.


The procedure then calls one of four procedures with the document file name (including path) and extension as arguments, depending on the merge type.

The cmdCreateDocuments_Click procedure is listed as follows:

Private Sub cmdCreateDocuments_Click()

On Error GoTo ErrorHandler

Dim cbo As Access.ComboBox Dim strCompanyName As String Dim strContactName As String Dim strJobTitle As String Dim strTestFile As String Dim strWordTemplate As String Dim strTest As String Dim strDocType As String Dim strMergeType As String Dim strExtension As String

Check that a document has been selected:

Set cbo = Me![cboSelectDocument] strWordTemplate = Nz(cbo.Value) If strWordTemplate = "" Then

MsgBox "Please select a document" cbo.SetFocus cbo.Dropdown GoTo ErrorHandlerExit End If strTemplatePath = GetContactsTemplatesPath() Debug.Print "Template path: " & strTemplatePath strWordTemplate = strTemplatePath & strWordTemplate

Check for the template in the selected 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 document" GoTo ErrorHandlerExit End If

Call the appropriate procedure depending on the selected merge type:

strMergeType = Nz(Me![cboSelectDocument].Column(2)) If Right(strWordTemplate, 1) = "x" Then strExtension = ".docx" Else strExtension = ".doc" End If

Select Case strMergeType

Case "Doc Props"

Call MergeDocProps(strWordTemplate, strExtension)

Case "Bookmarks"

Call MergeBookmarks(strWordTemplate, strExtension)

Case "TypeText"

Call MergeTypeText(strWordTemplate, strExtension)

Case "Mail Merge"

Call MailMerge(strWordTemplate, strExtension)

End Select

ErrorHandlerExit: Exit Sub


& "; Description: " & Err.Description Resume ErrorHandlerExit

End Sub

If a document of the Doc Props merge type is selected, the MergeDocProps procedure is called. This procedure first sets a reference to the handy ItemsSelected collection of the ListBox (this collection includes only the rows selected in the ListBox), then iterates through the collection, creating a new Word document for each contact record.

The code then sets a reference to the Word CustomDocumentProperties collection of the newly created document, and sets each document property to the value in a column of the current row from the ListBox. A save name is created, including the document title, contact name, company name, and date, and the document is saved:

Private Sub MergeDocProps(strWordTemplate As String, _ strExtension As String)

On Error GoTo ErrorHandler strLongDate = Format(Date, "mmmm d, yyyy") strShortDate = Format(Date, "m-d-yyyy") strDocsPath = GetContactsDocsPath() Debug.Print "Docs path: " & strDocsPath

Check that at least one contact has been selected:

Set 1st = Me![lstSelectContacts]

If lst.ItemsSelected.Count = 0 Then

MsgBox "Please select at least one contact" lst.SetFocus GoTo ErrorHandlerExit End If intColumns = lst.ColumnCount intRows = lst.ItemsSelected.Count

For Each varltem In lst.ItemsSelected

Check for required address information:

strTest = Nz(lst.Column(5, varltem)) Debug.Print "Street address: " & strTest If strTest = "" Then

Debug.Print "Skipping this record -- no address!" GoTo ErrorHandlerExit End If strTest = Nz(lst.Column(1, varltem)) Debug.Print "Contact name: " & strTest If strTest = "" Then Debug.Print _

"Skipping this record -- no contact name!" GoTo ErrorHandlerExit End If strContactName = _

Nz(lst.Column(1, varltem) strCompanyName = _

Nz(lst.Column(7, varltem)

Open a new document based on the selected template:

Set appWord = GetObject(Class:="Word.Application") appWord.Documents.Add strWordTemplate

Write information to Word custom document properties:


Turn off error handler because some templates don't have all of the doc properties:

On Error Resume Next prps.Item("NameTitleCompany").Value = _

Nz(lst.Column(2, varltem)) prps.Item("WholeAddress").Value = _

Nz(lst.Column(5, varltem)) prps.Item("Salutation").Value = _

Nz(lst.Column(10, varltem)) prps.Item("TodayDate").Value = strLongDate prps.Item("CompanyName").Value = _

strCompanyName prps.Item("JobTitle").Value = _

Nz(lst.Column(8, varItem)) prps.Item("ZipCode").Value = _

Nz(lst.Column(6, varItem)) prps.Item("ContactName").Value = strContactName

On Error GoTo ErrorHandler

Check for a previously saved document in the documents folder, and append an incremented number to the save name if one is found:

strDocType = _


BuiltInDocumentProperties(wdPropertyTitle) strSaveName = strDocType & " to " _

& strContactName & " - " & strCompanyName strSaveName = strSaveName & " on " _

& strShortDate & strExtension 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 a new save name with the incremented number: intSaveNameFail = True strSaveName = strDocType & " " & CStr(i) _ & " to " & strContactName & " - " _ & strCompanyName strSaveName = strSaveName & " on " _

& strShortDate & strExtension strSaveNamePath = strDocsPath & strSaveName Debug.Print "New save name and path: " _

Debug.Print "Save name not used: " & strSaveName intSaveNameFail = False End If

NextContact: Loop

Update fields in Word document and save it:

Re-hide ZipCode field

With appWord.Selection

.GoTo What:=wdGoToBookmark, Name:="ZipCode" .Find.ClearFormatting .Font.Hidden = True End With

With appWord

.Selection.WholeStory .Selection.Fields.Update .Selection.HomeKey unit:=wdStory .ActiveDocument.SaveAs strSaveNamePath End With Next varltem

With appWord

.ActiveWindow.WindowState = wdWindowStateNormal .Visible = True .Activate End With

ErrorHandlerExit: Exit Sub


If Err = 429 Then

'Word is not running; open Word with CreateObject Set appWord = CreateObject(Class:="Word.Application") Resume Next


& "; Description: " & Err.Description Resume ErrorHandlerExit End If

End Sub

For a list of the built-in Word named constants that can be used as arguments for functions or methods, or set as the values of properties, look up the appropriate enumeration (enum) in the Object Browser. Word enums start with Wd and are at the bottom of the Classes list. For example, to see what named constants can be used for the WindowState property of the ActiveWindow property, look up the WdWindowState enum, which is shown in Figure 6.19.


Examining the WdWindowState enum in the Object Browser.

1 "¡5 Mici os ölt Visual B.isic - Worn Export - [Object Browser]


File Edit View

Insert Debug Run Tools Add-Ins

Window Help

I - 0 - id mJ ... - « J «£ i Sj

Project word Export s(

I #4 =

% > f

El ¡g? aewzmain (ACV > B Word Export (Vi_| B Ö Microsoft Offi _m Form Coc '*"

Properties X |

Classes 1Wd Units dp WdUseFormattingFrom WdVerticaiAlignment WdViewType i# WdVisualSelectlon

Members of WdWindowState' (3 wdWindowState Maximize ID wdWindowStateMinimize E) wdWindowState Normal

Alphabetic | Categorized

# WdWindowType" WdWordDialog itfJ WdWordDialogTab dp WdWrap Si deType WdWrapType WdWrapTypeMerged

Enum WilWindowState Member of Word

The cmdDeselectAll_Click procedure, run from the Clear All Selections command button, deselects all the rows in the listbox, even the ones you can't see, so you can start fresh:

Private Sub cmdDeselectAll_Click() On Error GoTo ErrorHandler

Set lst = Me![lstSelectContacts] intRows = lst.ListCount - 1

For intlndex = 0 To intRows lst.Selected(intlndex) = False Next intlndex

ErrorHandlerExit: Exit Sub


& "; Description: " & Err.Description Resume ErrorHandlerExit

End Sub

The cmdSelectAll_Click procedure, run from the Select All Names command button, selects all the rows in the listbox; its code is similar, setting the Selected value to True instead of False.

Clicking the Clear All Selections command button clears any selections you have made in the listbox; clicking the Create Documents command button starts the merge, calling one of four procedures, depending on the merge type.

0 0

Post a comment