Delivering a Word Template for Use in Merging Data from Access

Helen Feddema
CERTIFIED EXPERT
Published:
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and installed automatically, for .mdb and .accdb databases.

Introduction

If you have ever had a long phone conversation with a user of one of your databases, in which you tried to guide them through installing a Word template in the right location for use in your merge code, you know this isn't an easy task, especially if the user isn't computer-savvy.  You might have to instruct the user on the difference between a document and a template, or what a zip file is, or why you can't just work with items in the zip, but have to extract them first.  Then there is the issue of where the template files should be saved.  Most users won't have a clue (see my article on Finding the Office Templates Folder for the steps needed to locate this folder in various Office versions).

  

Rather than engage in a long and frustrating phone conversation (in which you can't ever be sure that the template did in fact get installed in the right folder), or perhaps having to set up a remote session so you can do it yourself (not always possible, because of security issues), I developed a method of delivering a Word template that is completely automatic, requiring only a few clicks on the part of the user to do a merge using the template – no programming or advanced Access or Word skills are required, at least on the part of the end user.  There are two versions of this method, one for Access 2003 and one for Access 2007-2016, the first using the OLE Object field data type and the second using the new (to Access 2007) Attachment field.  


Quick Demo

To see how this technique works, open either database – the 2003 version (Embedded Templates.mdb) or the 2007 version (Embedded Templates.accdb).   A simple menu opens (this is the User menu; a more complex menu, the Developer menu, is described later in this article).  While the code that extracts the templates differs in the two databases, the user experience is the same, so I will illustrate the 2007 version.  

The User version of the main menu has all choices hard-coded except the choice of Document Properties or TypeText merges in the Method option group (Document Properties is pre-selected):

All the user has to do is click the Merge to Word button to open one of the two forms that merge contact data to Word documents.  The TypeText form is shown below:

A multi-select listbox lets you select contacts, or if you want to create documents for all the contacts, just click the Select All button (or click Deselect All to clear your choices and start over).  Once a template and at least one contact have been selected, the Create Labels button is enabled, and clicking it starts the merge.

For the User version, templates are stored in the default Templates folder, and merge documents are created in the current database path, with save names using the d-mmm-yyyy date format.  A sheet of Avery #5161 labels created from the TypeText form, with all contacts selected, is shown below:

At the end of the merge, a dialog informs you about how many labels have been created, and whether the template used to create them was already in the Templates folder, or just extracted to that folder.

The following sections describe the behind-the-scenes techniques for embedding the templates into table fields, and list the code that extracts the template needed for a merge, and saves it to the appropriate folder.


Access 2003 Method Embedded Templates.mdb

The Embedded Templates.mdb database (link above) has a table called tlkpWordTemplates with an OLE Object field where the templates are stored.  To embed a Word template in the OLE Object field, open the table in datasheet view, enter the template name (with extension) and the display name in the first two fields, and right-click the WordTemplate field.



Select Insert Object, click Create from File in the dialog that opens, and browse for the template you want to insert.



The template now appears as a Microsoft Word Document in the table.  This table also has several Yes/No fields indicating the template type, for use when selecting a template on forms.

The sample database, Embedded Templates.mdb, has two versions of the main menu, Developer and User.  The Developer version is the one that opens when the database is opened.


Developer Version

The top group of controls on the developer version of the main menu includes a button for opening one of two forms for merging Access data to Word, and an option group for selecting the merge type.  Below this group, there is a combo box for selecting the date format for use in creating document save names, an option group for selecting the type of folders to use, and two buttons for selecting the Word Templates path and Word Documents path.



The Document Save Date Format combo box offers a choice of date formats, all appropriate for use in file names, so no slashes:


The Folders option group offers a choice of Default/Current – use the default Templates folder for templates, and the current database path for merge documents. The reason I use the current path instead of the default Documents path is that the Word syntax that should return the Documents path (appWord.Options.DefaultFilePath(wdDocumentsPath)) in fact frequently returns the current path instead, so it is not reliable.

The Custom option enables the folder path selectors, so you can select your own choice of folders for the Word templates used by the database and the merge documents it creates.

The path selectors use the Office FileDialog object to open a Folder Picker dialog for selecting the paths for your templates and the documents created from them.  The code for selecting the Templates folder is listed below:

Private Sub cmdWordTemplatesPath_Click()

On Error GoTo ErrorHandler
 
   'Create a FileDialog object as a Folder Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   Set txt = Me![txtWordTemplatesPath]
   strPropertyName = "WordTemplatesPath"
   strPath = GetProperty(strPropertyName, "")
   Set appWord = GetObject(, "Word.Application")
   strTemplatesPath = appWord.Options.DefaultFilePath(wdUserTemplatesPath) _
      & "\"
   
   If strPath = "" Then
      strPath = strTemplatesPath
   End If
   
   With fd
      .Title = "Browse for folder where Word templates are stored"
      .ButtonName = "Select"
      .InitialView = msoFileDialogViewDetails
      .InitialFileName = strPath
      If .Show = -1 Then
         strPropertyValue = CStr(fd.SelectedItems.Item(1))
         lngDataType = dbText
         Call SetProperty(strPropertyName, lngDataType, _
	    strPropertyValue)
         txt.Value = strPropertyValue
      Else
        'Debug.Print "User pressed Cancel"
      End If
   End With
   
   Me![cmdMergetoWord].Enabled = CheckProps
 
ErrorHandlerExit:
   Exit Sub
 
ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number _
         & " in " & Me.ActiveControl.Name & " procedure; " _
         & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If
 
End Sub


Once you have made your selections, click the Merge to Word button to open one of two forms, each of which has a listbox for selecting contacts, and a choice of templates for creating documents to the selected contacts.  Here is the form that uses Word document properties to hold the data merged from Access:



Once the template has been selected, and at least one contact has been selected, the Create Documents button  is enabled, and you can do the merge.

If you look at frmDocPropsET in Design view, you will see a Subform control on the right side.  This control (which has its Visible property set to False so it won't show in Form view) has as its source object the form fsubWordTemplatesDP, which is bound to tlkpWordTemplates.  

This control is needed because the code needs to work with the Bound Object control that is bound to the WordTemplate field.  Once the template has been extracted and saved, it will be used directly from the Templates folder in future, but if it is deleted, moved or renamed, it will once again be extracted from the OLE Object field.



After clicking the Create Documents button to create the documents, when the code completes you will get a success message like the one shown below:



A one-up label is shown below:



Finally, a text file is creating listing the details:



The code for creating documents is listed below:


Private Sub cmdCreateDocuments_Click()
 On Error GoTo ErrorHandler
 Dim appWord As Word.Application
 Dim blnEmbedded As Boolean
 Dim cbo As Access.ComboBox
 Dim doc As Word.Document
 Dim docTemplate As Word.Document
 Dim fil As Scripting.File
 Dim fso As New Scripting.FileSystemObject
 Dim i As String
 Dim intReturn As Integer
 Dim intSaveNameFail As Integer
 Dim lngRecordCount As Long
 Dim lngSelectCount As Long
 Dim lst As Access.ListBox
 Dim prps As Object
 Dim strAddress As String
 Dim strCity As String
 Dim strCompanyName As String
 Dim strContactName As String
 Dim strContactNameAndJob As String
 Dim strCountry As String
 Dim strDefaultDocsPath As String
 Dim strDefaultTemplatesPath As String
 Dim strDocsPath As String
 Dim strDocType As String
 Dim strJobTitle As String
 Dim strLogFile As String
 Dim strLongDate As String
 Dim strPostalCode As String
 Dim strProgressBarText As String
 Dim strPrompt As String
 Dim strSalutation As String
 Dim strSaveDate As String
 Dim strSaveDateFormat As String
 Dim strSaveName As String
 Dim strSaveNamePath As String
 Dim strState As String
 Dim strStreetAddress As String
 Dim strTemplateName As String
 Dim strTemplateNameAndPath As String
 Dim strTemplatesPath As String
 Dim strTest As String
 Dim strTestFile As String
 Dim strTitle As String
 Dim ts As Scripting.TextStream
 Dim varItem As Variant
 

 Set lst = Me![lstSelectContacts]
 blnEmbedded = False
 

 'Check that a template has been selected
 Set cbo = Me![cboSelectDocument]
 strTemplateName = Nz(cbo.Value)
 If strTemplateName = "" Then
 strTitle = "No template selected"
 strPrompt = "Please select a template"
 MsgBox prompt:=strPrompt, _
 buttons:=vbInformation + vbOKOnly, _
 Title:=strTitle
 cbo.SetFocus
 cbo.Dropdown
 GoTo ErrorHandlerExit
 Else
 Debug.Print "Template: " & strTemplateName
 strDocType = cbo.Column(1)
 End If
 

 'Set Word application variable; if Word is not running,
 'the error handler defaults to CreateObject
 Set appWord = GetObject(, "Word.Application")
 

 strSaveDateFormat = GetProperty("SaveDateFormat", "")
 strSaveDate = Format(Date, strSaveDateFormat)
 

 'Get Templates path from custom database property
 strTemplatesPath = GetProperty("WordTemplatesPath", "")
 strTemplateNameAndPath = strTemplatesPath & strTemplateName
 Debug.Print "Template name and path: " & strTemplateNameAndPath
 'Set Documents path from custom database property
 strDocsPath = GetProperty("WordDocsPath", "")
 Debug.Print "Documents path: " & strDocsPath
 

 On Error Resume Next
 'Check for existence of template in templates folder,
 'and exit if not found
 Set fil = fso.GetFile(strTemplateNameAndPath)
 

 On Error GoTo ErrorHandler
 

 If fil Is Nothing Then
 'Extract template from the bound object frame control in the
 'subform and save it to the Templates path
 blnEmbedded = True
 With Me![subWordTemplates]![frbWordTemplate]
 .Class = "Word.Template"
 .Verb = acOLEVerbOpen
 .Action = acOLEActivate
 Set docTemplate = .Object.Application.Documents.Item(1)
 End With
 

 'Save the extracted template to the default Templates path
 docTemplate.SaveAs FileName:=strTemplateNameAndPath, _
 FileFormat:=wdFormatTemplate
 

 'Make a new document from the saved template
 Set doc = appWord.Documents.Add(Template:=strTemplateNameAndPath, _
 DocumentType:=wdFormatDocument)
 

 'Close extracted template document
 Debug.Print docTemplate.Name
 Me![subWordTemplates]![frbWordTemplate].Action = acOLEClose
 

 'Bring new document made from template to front
 'appWord.WindowState = wdWindowStateNormal
 GoTo CreateLetter
 Else
 'Open a new letter based on the selected template
 Set doc = appWord.Documents.Add(strTemplateNameAndPath)
 GoTo CreateLetter
 End If
 

 CreateLetter:
 'Check that at least one contact has been selected
 lngSelectCount = lst.ItemsSelected.Count
 

 If lngSelectCount = 0 Then
 strTitle = "No contacts selected"
 strPrompt = "Please select at least one contact"
 MsgBox prompt:=strPrompt, _
 buttons:=vbInformation + vbOKOnly, _
 Title:=strTitle
 lst.SetFocus
 GoTo ErrorHandlerExit
 Else
 Debug.Print "Select count: " & lngSelectCount
 End If
 

 If lngSelectCount > 199 Then
 strTitle = "Problem"
 strPrompt = "Can't create " & lngSelectCount _
 & " documents; canceling"
 MsgBox prompt:=strPrompt, _
 buttons:=vbExclamation + vbOKOnly, _
 Title:=strTitle
 GoTo ErrorHandlerExit
 ElseIf lngSelectCount > 99 Then
 strTitle = "Question"
 strPrompt = "Create documents for " & lngSelectCount _
 & " contacts?"
 intReturn = MsgBox(prompt:=strPrompt, _
 buttons:=vbQuestion + vbYesNo, _
 Title:=strTitle)
 If intReturn = vbNo Then
 GoTo ErrorHandlerExit
 End If
 End If
 

 'Create log file document
 strLogFile = strDocsPath & "Log File of documents created on " _
 & strSaveDate & " at " _
 & Format(Now, "hh_mm_ss ampm") & ".txt"
 Debug.Print "Log file name: " & strLogFile
 Set ts = fso.OpenTextFile(FileName:=strLogFile, _
 IOMode:=ForWriting, _
 Create:=True)
 

 strProgressBarText = "Creating documents... "
 Call SysCmd(acSysCmdInitMeter, strProgressBarText, _
 lngSelectCount)
 

 'Set starting value for record number
 lngRecordCount = 0
 

 'Test for required information, using listbox columns
 For Each varItem In lst.ItemsSelected
 'Check for required address information
 strTest = Nz(lst.Column(5, varItem))
 'Debug.Print "Street address: " & strTest
 If strTest = "" Then
 'Debug.Print "Skipping this record -- no street address!"
 GoTo NextContact
 End If
 

 strTest = Nz(lst.Column(6, varItem))
 'Debug.Print "City: " & strTest
 If strTest = "" Then
 'Debug.Print "Skipping this record -- no city!"
 GoTo NextContact
 End If
 

 strTest = Nz(lst.Column(8, varItem))
 'Debug.Print "Postal code: " & strTest
 If strTest = "" Then
 'Debug.Print "Skipping this record -- no postal code!"
 GoTo NextContact
 End If
 

 strCompanyName = Nz(lst.Column(10, varItem))
 'Debug.Print "Company name: " & strCompanyName
 

 strSalutation = Nz(lst.Column(4, varItem))
 'Debug.Print "Salutation: " & strSalutation
 

 strContactName = Nz(lst.Column(2, varItem)) & _
 " " & Nz(lst.Column(3, varItem))
 strJobTitle = Nz(lst.Column(11, varItem))
 If strJobTitle <> "" Then
 strContactNameAndJob = strContactName & vbCrLf _
 & strJobTitle
 Else
 strContactNameAndJob = strContactName
 End If
 

 strStreetAddress = Nz(lst.Column(5, varItem))
 strCity = Nz(lst.Column(6, varItem))
 strState = Nz(lst.Column(7, varItem))
 strPostalCode = Nz(lst.Column(8, varItem))
 

 strAddress = strStreetAddress & vbCrLf & strCity & ", " _
 & strState & " " & strPostalCode
 'Debug.Print "Address: " & strAddress
 

 strCountry = Nz(lst.Column(9, varItem))
 If strCountry <> "USA" Then
 strAddress = strAddress & vbCrLf & strCountry
 End If
 

 'Open a new letter based on the selected template
 Set doc = appWord.Documents.Add(strTemplateNameAndPath)
 

 'Write information to Word custom document properties
 Set prps = doc.CustomDocumentProperties
 prps.Item("ContactName").Value = strContactNameAndJob
 prps.Item("Salutation").Value = strSalutation
 prps.Item("CompanyName").Value = strCompanyName
 prps.Item("Address").Value = strAddress
 prps.Item("TodayDate").Value = strLongDate
 

 'Check for existence of previously saved letter in documents folder,
 'and append an incremented number to save name if found
 strSaveName = strDocType & " to " & _
 lst.Column(2, varItem) & " " & lst.Column(3, varItem)
 strSaveName = strSaveName & " on " & strSaveDate & ".docx"
 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
 strContactName = lst.Column(2, varItem) & " " _
 & lst.Column(3, varItem)
 strSaveName = strDocType & " " & CStr(i) & " to " & _
 strContactName
 strSaveName = strSaveName & " on " & strSaveDate & ".docx"
 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
 

 Call SaveMailingInfo(strDocType, strContactName)
 

 lngRecordCount = lngRecordCount + 1
 Debug.Print "Updating progress bar for record " _
 & lngRecordCount & " of "; lngSelectCount & " records"
 Call SysCmd(acSysCmdUpdateMeter, lngRecordCount)
 ts.WriteLine strSaveName
 ts.WriteBlankLines 1
 

 NextContact:
 Next varItem
 

 strTitle = "Done"
 

 If blnEmbedded = False Then
 If lngRecordCount = 1 Then
 strPrompt = strDocType & " created for " _
 & strContactName & ", using template in folder"
 Else
 strPrompt = lngRecordCount & " " & strDocType _
 & "s created, using template in folder"
 End If
 ElseIf blnEmbedded = True Then
 If lngRecordCount = 1 Then
 strPrompt = strDocType & " created for " _
 & strContactName & ", using embedded template"
 Else
 strPrompt = lngRecordCount & " " & strDocType _
 & "s created, using embedded template"
 End If
 End If
 

 MsgBox prompt:=strPrompt, _
 buttons:=vbInformation + vbOKOnly, _
 Title:=strTitle
 Call SysCmd(acSysCmdRemoveMeter)
 Call BringDocToFront(appWord, doc)
 OpenTextFile (strLogFile)
 

 ErrorHandlerExit:
 If Not ts Is Nothing Then
 ts.Close
 End If
 

 Set fil = Nothing
 Set appWord = Nothing
 Exit Sub
 ErrorHandler:
 If Err = 429 Then
 'Word is not running; open Word with CreateObject
 Set appWord = CreateObject("Word.Application")
 Resume Next
 Else
 MsgBox "Error No: " & Err.Number & "; Description: " _
 & Err.Description
 Resume ErrorHandlerExit
 End If


 
End Sub

 

User Version

The User version of the main menu (frmMainUser) is a cut-down version of the Developer menu, with all choices hard-coded except the choice of Document Properties or TypeText merges in the Method option group (Document Properties is pre-selected):



All the user has to do is click the Merge to Word button to open one of the two forms that merge contact data to Word documents.  The TypeText form is shown below:



For the User version, templates are stored in the default Templates folder, and merge documents are created in the current database path, with save names using the d-mmm-yyyy date format.  A sheet of Avery #5161 labels created from the TypeText form, with all contacts selected, is shown below:



At the end of the merge, a dialog informs you about how many documents have been created, and whether the template used to create them was already in the Templates folder, or just extracted to that folder.



The code for creating labels differs from the code forcreating documents using doc properties; here is the relevant section of code, which uses the TypeText method to insert data into cells of a Labels document:

With appWord

.Selection.HomeKey Unit:=wdLine

.Selection.TypeText Text:=strContactNameAndJob

.Selection.TypeParagraph

.Selection.TypeText Text:=strCompanyName

.Selection.TypeParagraph

.Selection.TypeText Text:=strAddress

.Selection.TypeParagraph

.Selection.MoveRight Unit:=wdCell

End With


Access 2007 (and higher) Method Embedded Templates.accdb

In the Access 2007 and any higher version of the database, Embedded Templates.accdb, the forms that work with embedded templates use the new Attachment type field in tlkpWordTemplates instead of the older OLE Object field to store the Word templates. The sample database and screen shots illustrate Access 2010, but the process is the same in Access 2013 and 2016, with only cosmetic differences.


The new Attachment type fields are easier to work with than OLE Object fields (there is no need to use a Bound Object control to get at the stored objects), and they don't take up as much space in the database – about half as much space as the same object stored in an OLE Object field, in my experience.


To embed a Word template in an Attachment field, open the tlkpWordTemplates table in datasheet view, and double-click the paperclip icon to open the Attachments dialog. 


Click Add to browse for the template to store in the field.


When storing a template in an Attachment field, there is no need for a subform; the template extraction is all done in VBA code working with the Attachments collection of the WordTemplate Attachment type field.  The Click event procedure on the Create Documents button on frmDocPropsET is similar to the code in the Access 2003 database, except for this portion:


If fil Is Nothing Then

'Extract template from Attachment field and save it to

'the Templates path

blnEmbedded = True

Call SaveAttachment(strTemplateName)

End If

 

The SaveAttachment procedure is listed below; it is called from both ET forms in this database, to extract the appropriate template if it is not found in the Templates folder:


Public Sub SaveAttachment(strTemplate As String)
 On Error GoTo ErrorHandler




Dim rstAttachments As DAO.Recordset

Dim rstTable As DAO.Recordset

Dim strDefaultTemplatesPath As String

Dim strSearch As String

Dim strFileAndPath As String




Set appWord = GetObject(, "Word.Application")




'Get default Templates path from db proprty

strDefaultTemplatesPath = GetProperty("WordTemplatesPath", "")

strFileAndPath = strDefaultTemplatesPath & strTemplate




Set rstTable = CurrentDb.OpenRecordset("tlkpWordTemplates", _

dbOpenDynaset)

strSearch = "[TemplateName] = " & Chr(39) & strTemplate & Chr(39)

'Debug.Print "Search string: " & strSearch




rstTable.FindFirst strSearch




If rstTable.NoMatch = False Then

'Create recordset of attachments for this record

Set rstAttachments = _

rstTable.Fields("WordTemplate").Value

With rstAttachments

Do While Not .EOF

'Save this attachment to a file in the Templates folder

'Debug.Print "Saving " & strFileAndPath

.Fields("FileData").SaveToFile strFileAndPath

.MoveNext

Loop

.Close

End With

End If




rstTable.Close




ErrorHandlerExit:

Exit Sub


ErrorHandler:

If Err = 429 Then

'Word is not running; open Word with CreateObject

Set appWord = CreateObject("Word.Application")

Resume Next

Else

MsgBox "Error No: " & Err.Number _

& " in SaveAttachment procedure" _

& "; Description: " & Err.Description

Resume ErrorHandlerExit

End If



End Sub


The sample database, Embedded Templates.accdb, has two versions of the main menu, Developer and User.  The Developer version is the one that opens when the database is opened.


Developer Version

The top group of controls on the developer version of the main menu includes a button for opening one of two forms for merging Access data to Word, and an option group for selecting the merge type.  Below this group, there is a combo box for selecting the date format for use in creating document save names, an option group for selecting the type of folders to use, and two buttons for selecting the Word Templates path and Word Documents path.



The Document Save Date Format combo box offers a choice of date formats, all appropriate for use in file names, so no slashes:



The Folders option group offers a choice of Default/Current – use the default Templates folder for templates, and the current database path for merge documents. The reason I use the current path instead of the default Documents path is that the Word syntax that should return the Documents path (appWord.Options.DefaultFilePath(wdDocumentsPath)) in fact frequently returns the current path instead, so it is not reliable.


The Custom option enables the folder path selectors, so you can select your own choice of folders for the Word templates used by the database and the merge documents it creates.


The path selectors use the Office FileDialog object to open a Folder Picker dialog for selecting the paths for your templates and the documents created from them.  The code for selecting the Templates folder is listed below:

Private Sub cmdWordTemplatesPath_Click()

On Error GoTo ErrorHandler


'Create a FileDialog object as a Folder Picker dialog box.

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Set txt = Me![txtWordTemplatesPath]

strPropertyName = "WordTemplatesPath"

strPath = GetProperty(strPropertyName, "")

Set appWord = GetObject(, "Word.Application")

strTemplatesPath = appWord.Options.DefaultFilePath(wdUserTemplatesPath) _

& "\"




If strPath = "" Then

strPath = strTemplatesPath

End If




With fd

.Title = "Browse for folder where Word templates are stored"

.ButtonName = "Select"

.InitialView = msoFileDialogViewDetails

.InitialFileName = strPath

If .Show = -1 Then

strPropertyValue = CStr(fd.SelectedItems.Item(1))

lngDataType = dbText

Call SetProperty(strPropertyName, lngDataType, _

strPropertyValue)

txt.Value = strPropertyValue

Else

'Debug.Print "User pressed Cancel"

End If

End With




Me![cmdMergetoWord].Enabled = CheckProps


ErrorHandlerExit:

Exit Sub


ErrorHandler:

If Err = 429 Then

'Word is not running; open Word with CreateObject

Set appWord = CreateObject("Word.Application")

Resume Next

Else

MsgBox "Error No: " & Err.Number _

& " in " & Me.ActiveControl.Name & " procedure; " _

& "Description: " & Err.Description

Resume ErrorHandlerExit

End If

 
 
End Sub


Once you have made your selections, click the Merge to Word button to open one of two forms, each of which has a listbox for selecting contacts, and a choice of templates for creating documents to the selected contacts.  Here is the form that uses Word document properties to hold the data merged from Access:



Once the template has been selected, and at least one contact has been selected, the Create Documents button  is enabled, and you can do the merge.  A one-up label is shown below:



When a document merge is done, a text file is creating listing the details:



The code for creating documents is listed below:

Private Sub cmdCreateDocuments_Click()
 On Error GoTo ErrorHandler
 Dim appWord As Word.Application
 Dim blnEmbedded As Boolean
 Dim cbo As Access.ComboBox
 Dim doc As Word.Document
 Dim docTemplate As Word.Document
 Dim fil As Scripting.File
 Dim fso As New Scripting.FileSystemObject
 Dim i As String
 Dim intReturn As Integer
 Dim intSaveNameFail As Integer
 Dim lngRecordCount As Long
 Dim lngSelectCount As Long
 Dim lst As Access.ListBox
 Dim prps As Object
 Dim strAddress As String
 Dim strCity As String
 Dim strCompanyName As String
 Dim strContactName As String
 Dim strContactNameAndJob As String
 Dim strCountry As String
 Dim strDefaultDocsPath As String
 Dim strDefaultTemplatesPath As String
 Dim strDocsPath As String
 Dim strDocType As String
 Dim strJobTitle As String
 Dim strLogFile As String
 Dim strLongDate As String
 Dim strPostalCode As String
 Dim strProgressBarText As String
 Dim strPrompt As String
 Dim strSalutation As String
 Dim strSaveDate As String
 Dim strSaveDateFormat As String
 Dim strSaveName As String
 Dim strSaveNamePath As String
 Dim strShortDate As String
 Dim strState As String
 Dim strStreetAddress As String
 Dim strTemplateName As String
 Dim strTemplateNameAndPath As String
 Dim strTemplatesPath As String
 Dim strTest As String
 Dim strTestFile As String
 Dim strTitle As String
 Dim ts As Scripting.TextStream
 Dim varItem As Variant
 

 Set lst = Me![lstSelectContacts]
 blnEmbedded = False
 

 'Check that a template has been selected
 Set cbo = Me![cboSelectDocument]
 strTemplateName = Nz(cbo.Value)
 If strTemplateName = "" Then
 strTitle = "No template selected"
 strPrompt = "Please select a template"
 MsgBox prompt:=strPrompt, _
 buttons:=vbInformation + vbOKOnly, _
 Title:=strTitle
 cbo.SetFocus
 cbo.Dropdown
 GoTo ErrorHandlerExit
 Else
 Debug.Print "Template: " & strTemplateName
 strDocType = cbo.Column(1)
 End If
 

 'Set Word application variable; if Word is not running,
 'the error handler defaults to CreateObject
 Set appWord = GetObject(, "Word.Application")
 

 strSaveDateFormat = GetProperty("SaveDateFormat", "")
 strSaveDate = Format(Date, strSaveDateFormat)
 

 'Get Templates path from custom database property
 strTemplatesPath = GetProperty("WordTemplatesPath", "")
 strTemplateNameAndPath = strTemplatesPath & strTemplateName
 Debug.Print "Template name and path: " & strTemplateNameAndPath
 'Set Documents path from custom database property
 strDocsPath = GetProperty("WordDocsPath", "")
 Debug.Print "Documents path: " & strDocsPath
 

 On Error Resume Next
 'Check for existence of template in templates folder
 Set fil = fso.GetFile(strTemplateNameAndPath)
 

 On Error GoTo ErrorHandler
 

 If fil Is Nothing Then
 'Extract template from Attachments field and save it to the Templates path
 blnEmbedded = True
 Call SaveAttachment(strTemplateName)
 End If
 

 'Check that at least one contact has been selected
 lngSelectCount = lst.ItemsSelected.Count
 

 If lngSelectCount = 0 Then
 strTitle = "No contacts selected"
 strPrompt = "Please select at least one contact"
 MsgBox prompt:=strPrompt, _
 buttons:=vbInformation + vbOKOnly, _
 Title:=strTitle
 lst.SetFocus
 GoTo ErrorHandlerExit
 Else
 Debug.Print "Select count: " & lngSelectCount
 End If
 

 If lngSelectCount > 199 Then
 strTitle = "Problem"
 strPrompt = "Can't create " & lngSelectCount _
 & " documents; canceling"
 MsgBox prompt:=strPrompt, _
 buttons:=vbExclamation + vbOKOnly, _
 Title:=strTitle
 GoTo ErrorHandlerExit
 ElseIf lngSelectCount > 99 Then
 strTitle = "Question"
 strPrompt = "Create documents for " & lngSelectCount _
 & " contacts?"
 intReturn = MsgBox(prompt:=strPrompt, _
 buttons:=vbQuestion + vbYesNo, _
 Title:=strTitle)
 If intReturn = vbNo Then
 GoTo ErrorHandlerExit
 End If
 End If
 

 'Create log file document
 strLogFile = strDocsPath & "Log File of documents created on " _
 & strSaveDate & " at " _
 & Format(Now, "hh_mm_ss ampm") & ".txt"
 Debug.Print "Log file name: " & strLogFile
 Set ts = fso.OpenTextFile(FileName:=strLogFile, _
 IOMode:=ForWriting, _
 Create:=True)
 

 strProgressBarText = "Creating documents... "
 Call SysCmd(acSysCmdInitMeter, strProgressBarText, _
 lngSelectCount)
 

 'Set starting value for record number
 lngRecordCount = 0
 

 'Test for required information, using listbox columns
 For Each varItem In lst.ItemsSelected
 'Check for required address information
 strTest = Nz(lst.Column(5, varItem))
 'Debug.Print "Street address: " & strTest
 If strTest = "" Then
 'Debug.Print "Skipping this record -- no street address!"
 GoTo NextContact
 End If
 

 strTest = Nz(lst.Column(6, varItem))
 'Debug.Print "City: " & strTest
 If strTest = "" Then
 'Debug.Print "Skipping this record -- no city!"
 GoTo NextContact
 End If
 

 strTest = Nz(lst.Column(8, varItem))
 'Debug.Print "Postal code: " & strTest
 If strTest = "" Then
 'Debug.Print "Skipping this record -- no postal code!"
 GoTo NextContact
 End If
 

 strCompanyName = Nz(lst.Column(10, varItem))
 'Debug.Print "Company name: " & strCompanyName
 

 strSalutation = Nz(lst.Column(4, varItem))
 'Debug.Print "Salutation: " & strSalutation
 

 strContactName = Nz(lst.Column(2, varItem)) & _
 " " & Nz(lst.Column(3, varItem))
 strJobTitle = Nz(lst.Column(11, varItem))
 If strJobTitle <> "" Then
 strContactNameAndJob = strContactName & vbCrLf _
 & strJobTitle
 Else
 strContactNameAndJob = strContactName
 End If
 

 strStreetAddress = Nz(lst.Column(5, varItem))
 strCity = Nz(lst.Column(6, varItem))
 strState = Nz(lst.Column(7, varItem))
 strPostalCode = Nz(lst.Column(8, varItem))
 

 strAddress = strStreetAddress & vbCrLf & strCity & ", " _
 & strState & " " & strPostalCode
 'Debug.Print "Address: " & strAddress
 

 strCountry = Nz(lst.Column(9, varItem))
 If strCountry <> "USA" Then
 strAddress = strAddress & vbCrLf & strCountry
 End If
 

 'Open a new letter based on the selected template
 Set doc = appWord.Documents.Add(strTemplateNameAndPath)
 

 'Write information to Word custom document properties
 Set prps = doc.CustomDocumentProperties
 prps.Item("ContactName").Value = strContactNameAndJob
 prps.Item("Salutation").Value = strSalutation
 prps.Item("CompanyName").Value = strCompanyName
 prps.Item("Address").Value = strAddress
 prps.Item("TodayDate").Value = strLongDate
 

 'Check for existence of previously saved letter in documents folder,
 'and append an incremented number to save name if found
 strSaveName = strDocType & " to " & _
 lst.Column(2, varItem) & " " & lst.Column(3, varItem)
 strSaveName = strSaveName & " on " & strSaveDate & ".docx"
 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
 strContactName = lst.Column(2, varItem) & " " _
 & lst.Column(3, varItem)
 strSaveName = strDocType & " " & CStr(i) & " to " & _
 strContactName
 strSaveName = strSaveName & " on " & strSaveDate & ".docx"
 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
 

 Call SaveMailingInfo(strDocType, strContactName)
 

 lngRecordCount = lngRecordCount + 1
 'Debug.Print "Updating progress bar for record " _
 & lngRecordCount & " of "; lngSelectCount & " records"
 Call SysCmd(acSysCmdUpdateMeter, lngRecordCount)
 ts.WriteLine strSaveName
 ts.WriteBlankLines 1
 

 NextContact:
 Next varItem
 

 strTitle = "Done"
 

 If blnEmbedded = False Then
 If lngRecordCount = 1 Then
 strPrompt = strDocType & " created for " _
 & strContactName & ", using template in folder"
 Else
 strPrompt = lngRecordCount & " " & strDocType _
 & "s created, using template in folder"
 End If
 ElseIf blnEmbedded = True Then
 If lngRecordCount = 1 Then
 strPrompt = strDocType & " created for " _
 & strContactName & ", using embedded template"
 Else
 strPrompt = lngRecordCount & " " & strDocType _
 & "s created, using embedded template"
 End If
 End If
 

 MsgBox prompt:=strPrompt, _
 buttons:=vbInformation + vbOKOnly, _
 Title:=strTitle
 Call SysCmd(acSysCmdRemoveMeter)
 Call BringDocToFront(appWord, doc)
 OpenTextFile (strLogFile)
 

 ErrorHandlerExit:
 If Not ts Is Nothing Then
 ts.Close
 End If
 

 Set fil = Nothing
 Set appWord = Nothing
 Exit Sub
 ErrorHandler:
 If Err = 429 Then
 'Word is not running; open Word with CreateObject
 Set appWord = CreateObject("Word.Application")
 Resume Next
 Else
 MsgBox "Error No: " & Err.Number & "; Description: " _
 & Err.Description
 Resume ErrorHandlerExit
 End If
 End Sub
 


User Version

The User version of the main menu (frmMainUser) is a cut-down version of the Developer menu, with all choices hard-coded except the choice of Document Properties or TypeText merges in the Method option group (Document Properties is pre-selected):



All the user has to do is click the Merge to Word button to open one of the two forms that merge contact data to Word documents.  The TypeText form is shown below:



For the User version, templates are stored in the default Templates folder, and merge documents are created in the current database path, with save names using the d-mmm-yyyy date format.  A sheet of Avery #5161 labels created from the TypeText form, with all contacts selected, is shown below:



At the end of the merge, a dialog informs you about how many documents have been created, and whether the template used to create them was already in the Templates folder, or just extracted to that folder.



The code for creating labels differs from the code for creating documents using doc properties; here is the relevant section of code, which uses the TypeText method to insert data into cells of a Labels document:

With appWord

.Selection.HomeKey Unit:=wdLine

.Selection.TypeText Text:=strContactNameAndJob

.Selection.TypeParagraph

.Selection.TypeText Text:=strCompanyName

.Selection.TypeParagraph

.Selection.TypeText Text:=strAddress

.Selection.TypeParagraph

.Selection.MoveRight Unit:=wdCell

End With


Conclusion

Using the techniques described in this article to embed Word templates into either OLE Object or Attachment fields, you can avoid problems with the location of templates, and ensure that your Access code that creates documents from Word templates will work correctly on other computers, even if they can't tell a file from a folder.

 EE Article -- Delivering a Word Template.docx

0
2,149 Views
Helen Feddema
CERTIFIED EXPERT

Comments (0)

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.