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.
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.
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.
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
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
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.
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
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
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.
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.
Comments (0)