Displaying More Information about ListBox Items, Part 2

Access Archon #164 

The final (and most complex) procedure is the cmdWordLetters Click event procedure, which creates a new Word document from a hard-coded template for each selected contact; when it is done, the documents are open for inspection.

Private Sub cmdWordLetters_Click()


On Error GoTo ErrorHandler


   Dim appWord As Word.Application

   Dim doc As Word.Document

   Dim strWordTemplate As String

   Dim strTemplatesPath As String

   Dim strDocsPath As String

   Dim strFirstNameFirst As String

   Dim strNameAndAddress As String

   Dim strWholeAddress As String

   Dim strLastNameFirst As String

   Dim strSalutation As String

   Dim strCompanyName As String

   Dim strJobTitle As String

   Dim strLastMeeting As String

   Dim strLongDate As String

   Dim strShortDate As String

   Dim strTestFile As String

   Dim prps As Object

   Dim strSaveName As String

   Dim i As Integer

   Dim intSaveNameFail As Integer

   Dim strSaveNamePath As String


   Set appWord = GetObject(, “Word.Application”)

   strTemplatesPath = appWord.Options.DefaultFilePath(wdUserTemplatesPath) _

      & “”

   Debug.Print “Templates folder: ” & strTemplatesPath

   strDocsPath = appWord.Options.DefaultFilePath(wdDocumentsPath) & “”

   Debug.Print “Documents folder: ” & strDocsPath

   strWordTemplate = “Test Letter.dot”

   strWordTemplate = strTemplatesPath & “” & strWordTemplate

   strLongDate = Format(Date, “mmmm d, yyyy”)

   strShortDate = Format(Date, “m-d-yyyy”)


   ‘Check for existence of template in template folder,
   ‘and exit if not found, with a message indicating where the
   ‘code is looking for the template

   strTestFile = Nz(Dir(strWordTemplate))

   Debug.Print “Test file: ” & strTestFile

   If strTestFile = “” Then

      MsgBox strWordTemplate & ” template not found; can’t create letter”

      GoTo ErrorHandlerExit

   End If


   ‘Check that at least one contact has been selected

   Set lst = Me![lstSelectContacts]

   If lst.ItemsSelected.Count = 0 Then

      MsgBox “Please select at least one contact”


      GoTo ErrorHandlerExit

   End If


   For Each varItem In lst.ItemsSelected

      ‘Set variables to values from selected list item

      strFirstNameFirst = Nz(lst.Column(1, varItem))

      strNameAndAddress = Nz(lst.Column(2, varItem))

      strWholeAddress = Nz(lst.Column(3, varItem))

      strLastNameFirst = Nz(lst.Column(4, varItem))

      strSalutation = Nz(lst.Column(5, varItem))

      strCompanyName = Nz(lst.Column(6, varItem))

      strJobTitle = Nz(lst.Column(7, varItem))

      strLastMeeting = Nz(lst.Column(8, varItem))


      ‘Create a new letter based on the selected template

      Set doc = appWord.Documents.Add(strWordTemplate)


      ‘Write long date to bookmark


      appWord.Selection.Text = strLongDate


      ‘Write information to Word custom document properties

      Set prps = doc.CustomDocumentProperties

      prps.Item(“FirstNameFirst”).Value = strFirstNameFirst

      prps.Item(“NameAndAddress”).Value = strNameAndAddress

      prps.Item(“WholeAddress”).Value = strWholeAddress

      prps.Item(“LastNameFirst”).Value = strLastNameFirst

      prps.Item(“CompanyName”).Value = strCompanyName

      prps.Item(“Salutation”).Value = strSalutation

      prps.Item(“JobTitle”).Value = strJobTitle

      prps.Item(“LastMeetingDate”).Value = strLastMeeting


On Error GoTo ErrorHandler

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

      ‘strDocType = pappWord.ActiveDocument.BuiltInDocumentProperties(2)

      strSaveName = “Letter to ” & strFirstNameFirst

      strSaveName = strSaveName & ” on ” & strShortDate & “.doc”

      i = 2

      intSaveNameFail = True

      Do While intSaveNameFail

         strSaveNamePath = strDocsPath & strSaveName

         Debug.Print “Proposed save name and path: ” _

            & vbCrLf & strSaveNamePath

         strTestFile = Nz(Dir(strSaveNamePath))

         Debug.Print “Test file: ” & strTestFile

         If strTestFile = strSaveName Then

            Debug.Print “Save name already used: ” & strSaveName


            ‘Create new save name with incremented number

            intSaveNameFail = True

            strSaveName = “Letter ” & CStr(i) & ” to ” & strFirstNameFirst

            strSaveName = strSaveName & ” on ” & strShortDate & “.doc”

            strSaveNamePath = strDocsPath & strSaveName

            Debug.Print “New save name and path: ” _

               & vbCrLf & strSaveNamePath

            i = i + 1


            Debug.Print “Save name not used: ” & strSaveName

            intSaveNameFail = False

         End If



      ‘Update fields in Word document and save it

      With appWord



         .Selection.HomeKey Unit:=wdStory

         .ActiveDocument.SaveAs strSaveName

      End With

   Next varItem



   Exit Sub



   If Err = 429 Then

      ‘Word is not running; open Word with CreateObject

      Set appWord = CreateObject(“Word.Application”)

      Resume Next


      MsgBox “Error No: ” & Err.Number & “; Description: ” _

         & Err.Description

      Resume ErrorHandlerExit

   End If


End Sub



For information on working with document properties in Word, see my White Paper on this topic, which is included in the zip for this article.


The code in the sample database needs the following references (in addition to the default references):

Microsoft DAO 3.6 Object Library

Microsoft Word 11.0 Object Library

If you import code or objects into a database of your own, you may need to set one or more of these references.  The version number may differ, depending on your Office version; check the version you have.  References are set in the References dialog, opened from the VBA window.  For more information on working with references, see Access Archon #107, Working with References.

Supporting Files

The zip file containing this article, in Word format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site.  It is accarch164.zip, which is the last entry in the table of Access Archon columns for Access Watch.

Document Name

Document Type

Place in

More Info ListBox (AA 164).mdb

Access 2000 database (can also be used in higher versions of Access)

Wherever you want

White Paper — Adding Custom Doc Properties to a Word Template.doc

Word document

Wherever you want

Test Letter.dot

Word 97-2003 template

User templates folder