[Murray Muspratt-Rouse]

Having installed Office 2003 on another PC I would like to revisit a problem I have reported before. The following code processes all letter merge requests, starting with the deletion of the contents of MergeTable, which provides the merge data, and the running of Access 2003 queries to load what is required: -

Sub OpenWordDoc(strDocName As String, strLetterDescription As String, strFormName As String)
Dim objApp As Object
Dim objMMMD As Object
Dim strCurrentFileName As String
On Error Resume Next
DoCmd.OpenQuery "qrydeleteMergeTablerows"


'Load data to MergeTable with a query that collects the required data after update

If strFormName = "Volunteers" Then
If strLetterDescription = "REFERENCE REQUEST" Then
DoCmd.OpenQuery ("qryUpdateVolunteerRefereeLetterDate")
DoCmd.OpenQuery ("qryAppendVolunteerRefereedata")
Else
If strLetterDescription = "Referee chaser" Then
DoCmd.OpenQuery ("qryUpdateVolunteerRefereeChaserDate")
DoCmd.OpenQuery ("qryVolunteerRefereechaser")
Else
If strLetterDescription = "TRAINING DATES" Then
DoCmd.RunMacro ("Set up training dates data for merge")
Else
DoCmd.OpenQuery ("qryVolunteer")
End If
End If
End If
End If
If strFormName = "Clients" Then
If strLetterDescription = "REFERENCE CLIENT" Then
DoCmd.OpenQuery ("qryUpdateClientRefereeLetterDate")
DoCmd.OpenQuery ("qryAppendClientRefereedata")
Else
If strLetterDescription = "Client Referee chaser" Then
DoCmd.OpenQuery ("qryUpdateClientRefereeChaserDate")
DoCmd.OpenQuery ("qryClientRefereechaser")
Else
DoCmd.OpenQuery ("qryClient")
End If
End If
End If

The code which follows does the merge - I think!

strCurrentFileName = CurrentDb.Name

Set objApp = CreateObject("Word.Application")
objApp.Visible = False
'objApp.Activate
'Set objMMMD = objApp.Documents.Open(FileName:=strDocName)

objApp.Documents.Open FileName:=strDocName, ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False _
, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", XMLTransform:=""

objApp.ActiveDocument.MailMerge.OpenDataSource Name:= _
strCurrentFileName, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";Us er ID=Admin;Date Source=strCurrentFileName;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLE" _
, SQLStatement:="SELECT * FROM `mergetable`", SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess
With objApp.ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
End With
.Execute Pause:=False
End With

The code which follows must be what closes the merge document and leaves the result of the merge. I'm afraid I do not understand it at all - I suppose I must get a good VBA programming guide (suggestions welcome!)

Dim intSplitName As Integer
Dim intLength As Integer
intLength = Len(strDocName)
intSplitName = InStrRev(strDocName, "\", , vbTextCompare)
strDocName = Right(strDocName, intLength - intSplitName)


objApp.Windows(strDocName).Activate
objApp.ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
'objMMMD.Close SaveChanges:=False
'Set objMMMD = Nothing


'objApp.Documents.Open strDocName


objApp.Visible = True
objApp.Activate

End Sub

If the result is meant to be more than one letter only one appears. The only way to get all the letters out is to open the marge document in Word, identify the Access table - again! - and complete the merge.

All suggestions gratefully received!

Murray