Office Watch

Office 2013

Office Mobile / iPad

Office 2010

Office 2007

Office 2003

Office XP

Office for Mere Mortals

Access

Email

Buying Office

Office 365

Winks

Office News Wire

Join us!

Our Ebooks

Mobile | PDA

RSS


Search

Command Finder


Microsoft Office Bookshop

About

Home




Displaying More Information about ListBox Items, Part 2

by Access Watch

Bookmark and Share

  | Mobile | click for more article services     


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"

      lst.SetFocus

      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

      doc.Bookmarks("LongDate").Select

      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

         Else

            Debug.Print "Save name not used: " & strSaveName

            intSaveNameFail = False

         End If

      Loop

     

      'Update fields in Word document and save it

      With appWord

         .Selection.WholeStory

         .Selection.Fields.Update

         .Selection.HomeKey Unit:=wdStory

         .ActiveDocument.SaveAs strSaveName

      End With

   Next varItem

  

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 & "; Description: " _

         & Err.Description

      Resume ErrorHandlerExit

   End If

 

End Sub

 

Notes

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.

References

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

 

Article posted: Monday, 17 September 2007

there's more ...

If you liked this article you'll LOVE our new ebooks.

Office 2013: the real startup guide

OFFICE 2013: the real startup guide Everything you need to know about Office 2013 but Microsoft won't tell you.

How to save money, install, configure and use the new features in Office 2013.  Get it today - click here.

Windows 8 for Microsoft Office users

Windows 8 for Microsoft Office users A practical guide the new, changed and unfamiliar in Windows 8

A focused and unvarnished look at Windows 8, especially written for the many people who use Microsoft Office  Get it today - click here.

ORGANIZING OUTLOOK EMAIL - tame your Outlook 2010 Inbox

100+ pages of practical tips and help to streamline, automate and search your Inbox.  Get more than you ever thought possible from Outlook.  Read it today - click here.

More from Office Watch:



Article Services sponsored by: Office Watch Ebooks - available now to download and read today.
RSS feed for this category Subscribe

Translate | Mobile | Links
 Add to: Bookmarks | | DiggThis | Yahoo! My Web


New & Popular
» Discounts on Office 2013 purchase
» Using Conversations in Outlook
» OneDrive for Business alters files
» About Outlook Conversations
» Keep using your device on the plane
» Questionable Outlook holidays


Office Watch, Office for Mere Mortals, Access Watch and all titles used within the publications are Copyright © 1996-2014 Office Watch.
Microsoft Office, Microsoft Word, Microsoft Excel, Microsoft Outlook, Microsoft Powerpoint and doubtless many other names are registered trademarks of Microsoft Corporation.

Search  |  Sitemap |  Popular Topics | Privacy Statement |  Advertising |  Twitter |  Feedback / Contact Us
Office Watch is definitely not affiliated with Microsoft - and that's just one reason why we are so useful to Microsoft Office users around the world J (Erko).