Word connectivity

[Nick 'The Database Guy']

Hello Access People,

The problem that I have is with an address database, the issue that I
am having is that although I can get access to start word and fill in
the address, salutation etc I can only do this once without having to
restart access. I suspect that I am not closing something in the
correct way. This is the code that I am using:

Public Sub SendMail(Optional IncludeCCAddresses As Boolean)
On Error GoTo btnSendMail_Err
Dim appWord As Word.Application
Dim docs As Word.Documents
Dim strLetter As String
Dim strTemplateDir As String
Dim prps As Object
Dim sql As String
Dim strAccounts As String
Dim blnSingleLetter As Boolean

' Set the object variables
Set appWord = GetObject(, "Word.Application")
Set docs = appWord.Documents
If MsgBox("Have you written the letter that you would like to use
for this mail merge?", vbQuestion + vbYesNo, "Does the letter exist?")
= vbNo Then
If CurrentProject.AllForms!frmClientDetails.IsLoaded = True
Then
blnSingleLetter = True
End If
'This section takes care of the single and single with CC
addresses that the people write on the spur of the moment
docs.Add DocumentType:=wdNewBlankDocument
Set prps = appWord.ActiveDocument
With appWord
.Visible = True
.Activate
If IncludeCCAddresses = True Then
ActiveDocument.MailMerge.OpenDataSource
Name:=CurrentDb.Name, _ ConfirmConversions:=False, ReadOnly:=False,
LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="",
PasswordTemplate:="", WritePasswordDocument:="",
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto,
Connection:= _
"Provider=Microsoft.Jet.OLEDB.
4.0;Password="""";User ID=Admin;Data Source=currentdb.name;Mode=
Read;Extended Properties=""""; Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet
OLEDB:Engine" _
, SQLStatement:="SELECT * FROM
`qrySource`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
End If
With .Selection
.TypeParagraph
.TypeParagraph
.TypeParagraph
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphRight
If IncludeCCAddresses = False Then
.TypeText Text:=Forms!
frmClientDetails.cboAccountNo
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""ClientCode"""
End If
.TypeParagraph
If IncludeCCAddresses = False Then
.TypeText Text:=Forms!
frmClientDetails.lblAccountManager.Caption
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""FundManagerCode"""
End If
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeParagraph
If IncludeCCAddresses = False Then
.TypeText Text:=Forms!frmClientDetails!cboFullName
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""FullCorrespondenceName"""
End If
.TypeParagraph
If IncludeCCAddresses = False Then
.TypeText Text:=Forms!
frmClientDetails.txtAddressDetails
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""AdjustedFullAddress"""
End If
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphRight
.TypeText Text:=Format(Date, "dddd dd mmmm yyyy")
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TypeParagraph
.TypeParagraph
If IncludeCCAddresses = False Then
.TypeText Text:=IIf(Forms!
frmClientDetails.ogpStyle = 1, Forms!
frmClientDetails.lblSalutation.Caption, Nz(Forms!
frmClientDetails.lblInformalGreeting.Caption, Forms!
frmClientDetails.lblSalutation.Caption))
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""ClientName"""
End If
.TypeParagraph
' .TypeParagraph
.TypeParagraph
.TypeParagraph
.TypeParagraph
.TypeText Text:="With kind regards."
.TypeParagraph
.TypeParagraph
If IncludeCCAddresses = False Then
.TypeText Text:=IIf(Forms!
frmClientDetails.ogpStyle = 1, Forms!
frmClientDetails.lblSignOff.Caption, Nz(Forms!
frmClientDetails.lblInformalSignOff.Caption, Forms!
frmClientDetails.lblSignOff.Caption))
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""SignOff"""
End If
.TypeParagraph
.TypeParagraph
.TypeParagraph
.TypeParagraph
.TypeParagraph
If IncludeCCAddresses = False Then
.TypeText Text:=Forms!
frmClientDetails.lblFundManagerName.Caption
Else
.Fields.Add Range:=Selection.Range,
Type:=wdFieldMergeField, Text:="""FMName"""
End If
.MoveUp Unit:=wdLine, Count:=9
End With
If .ActiveWindow.View.SplitSpecial = wdPaneNone Then
.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
.ActiveWindow.View.Type = wdPrintView
End If
End With
Else
DoCmd.OpenForm "frmLetters"
End If

btnSendMail_Exit:
Set appWord = Nothing
Exit Sub

btnSendMail_Err:
If Err.Number = 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 btnSendMail_Exit
End If

End Sub

Any help would be appreciated.

Nick