******************************************************************************************************

  Word automation (creating a credit letter)

******************************************************************************************************

Option Compare Database

Option Explicit

' default template

Private Const gconTemplate As String = "C:\BegVBA\Credit.DOT"

Sub CreditLetter(lngPersonID As Long)

'

' Purpose:      Create a credit information letter

' Arguments:    lngPersonID         The id of the person at the company

'

    Dim dbC         As Database             ' current database

    Dim qryContact  As QueryDef             ' querydef of contact

    Dim recContact  As Recordset            ' recordset of contact details

    Dim objWord     As Word.Application     ' word object

    Dim objDoc      As Object        ' document object

    ' find the company and contact details

    Set dbC = CurrentDb()

    Set qryContact = dbC.QueryDefs("qryCompanyContacts")

    qryContact.Parameters("PID") = lngPersonID

    Set recContact = qryContact.OpenRecordset()

    If recContact.EOF Then

        MsgBox "The person with an ID of " & lngPersonID & " could not be found.", vbCritical, "Contact Not Found"

        Exit Sub

    End If

    ' create word and a letter based on the template

    Set objWord = New Word.Application

    objWord.Visible = True

    Set objDoc = objWord.Documents.Add(gconTemplate)

    ' fill in the details

    InsertTextAtBookmark objWord, objDoc, "Contact", recContact("FullName")

    InsertTextAtBookmark objWord, objDoc, "CompanyName", recContact("CompanyName")

    InsertTextAtBookmark objWord, objDoc, "Address", recContact("Address")

    InsertTextAtBookmark objWord, objDoc, "Town", recContact("Town")

    InsertTextAtBookmark objWord, objDoc, "PostCode", recContact("PostCode")

    InsertTextAtBookmark objWord, objDoc, "Dear", recContact("FirstName")

    ' close up

    objDoc.SaveAs "C:\BegVBA\CredLet"

    objDoc.Close

    objWord.Quit

    recContact.Close

    Set objDoc = Nothing

    Set objWord = Nothing

End Sub

Sub InsertTextAtBookmark(objW As Object, objD As Object, strBkmk As String, varText As Variant)

'

' Purpose:      Insert text at a bookmark

' Arguments:    objW        the word object

'               objD        the word document object

'               strBkmk     the bookmark name

'               varText     the text to insert

' Returns:      none

'

    ' select the required bookmark, and set the selection text

    objD.Bookmarks(strBkmk).Select

    objW.Selection.Text = varText

End Sub