Hi. I’ve created a function in Access to automatically merge about 80 queries with different letters in Word. The function is called from a macro. The merge works but frequently I’m left with about 20 copies of Access open on my desktop and I can’t figure out what’s causing the problem. I am running Office 2000 and Win95. Below is the code I’m using (I omitted some of the query names to save space). Thanks for your help!
Option Compare Database
Dim ObjWord As Word.Application
Const Size As Integer = 10
Dim strLetters(1 To Size)
Dim strMerge(1 To Size)
Function Merge_With_Word()
‘
‘ Merge_With_Word Macro
‘ Macro recorded 2/22/01 by Preferred User
‘
On Error GoTo errhandler
strLetters(1) = “Inq_Accounting.doc”
strLetters(2) = “Inq_Allied.doc”
strLetters(3) = “Inq_Behavsci.doc”
strLetters(4) = “Inq_Biology.doc”
strLetters(5) = “Inq_Busadm.doc”
strLetters(6) = “Inq_Busund.doc”
strLetters(7) = “Inq_Campvst.doc”
strLetters(8) = “Inq_Cheerld.doc”
strLetters(9) = “Inq_Chem.doc”
strLetters(10) = “Inq_Crimjust.doc”
strMerge(1) = “shell_inq_Accounting.doc”
strMerge(2) = “shell_inq_Allied.doc”
strMerge(3) = “shell_inq_Behavsci.doc”
strMerge(4) = “shell_inq_Biology.doc”
strMerge(5) = “shell_inq_Busadm.doc”
strMerge(6) = “shell_inq_Busund.doc”
strMerge(7) = “shell_inq_Campvst.doc”
strMerge(8) = “shell_inq_Cheerld.doc”
strMerge(9) = “shell_inq_Chem.doc”
strMerge(10) = “shell_inq_Crimjust.doc”
Set ObjWord = CreateObject(“word.application.9″)
ObjWord.Visible = True
‘ For loop – Merge document with query and create letters
For i = 1 To Size
ObjWord.ChangeFileOpenDirectory”C:WINDOWSDESKTOPInquiriesInquiry_Merge_Documents”
‘Merge
ObjWord.Documents.Open FileName:=strMerge(i), ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:=””, _
PasswordTemplate:=””, Revert:=False, WritePasswordDocument:=””, _
WritePasswordTemplate:=””, Format:=wdOpenFormatAuto
With ObjWord.ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = False
.MailAddressFieldName = “”
.MailSubject = “”
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=True
End With
ObjWord.ChangeFileOpenDirectory “C:WINDOWSDESKTOPInquiriesInquiry_Letters_to_Send”
‘Save Letter
ObjWord.ActiveDocument.SaveAs FileName:=strLetters(i), FileFormat:= _
wdFormatDocument, LockComments:=False, Password:=””, AddToRecentFiles:= _
True, WritePassword:=””, ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ObjWord.ActiveWindow.Close
ObjWord.ActiveDocument.Save
ObjWord.ActiveDocument.Close
Next i
‘ End For loop
Exit Function
‘ On error, continue with next instruction
errhandler:
Resume Next
End Function
