<

Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x

Delivering a Word Template for Use in Merging Data from Access

Published on
3,497 Points
497 Views
Last Modified:
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) _
      &amp; "\"
   
   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: " &amp; Err.Number _
         &amp; " in " &amp; Me.ActiveControl.Name &amp; " procedure; " _
         &amp; "Description: " &amp; 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
Comment
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
0 Comments

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Join & Write a Comment

This Micro Tutorial well show you how to find and replace special characters in Microsoft Word. This is similar to carriage returns to convert columns of values from Microsoft Excel into comma separated lists.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month