Mail Merge into MS Word

[Martin]

I used this site to get examples of Mail Merge code. Below you will find my
existing code that works just fine. It is used to print graduation
certificates for classes. The problem is the boss does not like the idea
that up to 24 different word docs get opened instead of one big combined
document. Everytime I try to change something I just get into more trouble.
I have a MS Word templete that I use to big the certificates. Should I make
a templete with upto 24 grad certificates in it? There just seems there
should be an easier answer.

Thank you for any help you can provide.


If Me.optCert = -1 Then

Set mysetgrad = db.OpenRecordset("tblGradRoster", DB_OPEN_TABLE) '
Open table for reading.

Debug.Print mysetgrad.RecordCount
iSSN = mysetgrad![SSN]

Do Until mysetgrad.EOF

If mysetgrad!PrintCERT Then
' Refresh querydefs collection
db.QueryDefs.Refresh

DoCmd.SetWarnings False
strSQL = "SELECT [tblACO new].SSN, Right([tblACO new]!SSN,4) AS
LAST4, [tblACO new].LNAME, [tblACO new].FNAME, "
strSQL = strSQL & "[tblACO new].MI , [tblACO new].SUFFIX,
tblGradRoster.COURSE, tblGradRoster.CLASSNO, "
strSQL = strSQL & "[tblSchool Schedule new].GRADUATE, [tblGrade
new].[Long Title], tblGradRoster.TITLE, "
strSQL = strSQL & "tblGradRoster.PMOS, tblGradRoster.CID,
tblGradRoster.[CE ID], tblGradRoster.Version, "
strSQL = strSQL & "tblGradRoster.Length, tblGradRoster.EXHIBIT,
tblGradRoster.LEARNING, tblGradRoster.INST, "
strSQL = strSQL & "tblGradRoster.CRED, tblGradRoster.CREDIT,
tblGradRoster.CREDIT1, tblGradRoster.CREDIT2, "
strSQL = strSQL & "tblGradRoster.CREDIT3 ,
tblGradRoster.CREDIT4, tblGradRoster.CREDIT5, tblGradRoster.CREDIT6, "
strSQL = strSQL & "tblGradRoster.MILGUIDE,
tblGradRoster.MILGUIDEWEB, tblGradRoster.Revision "
strSQL = strSQL & "FROM [tblSchool Schedule new] INNER JOIN
(tblGradRoster INNER JOIN ([tblGrade new] INNER JOIN "
strSQL = strSQL & "[tblACO new] ON [tblGrade new].Rank = [tblACO
new].RANK) ON tblGradRoster.SSN = [tblACO new].SSN) "
strSQL = strSQL & "ON ([tblSchool Schedule new].COURSE = [tblACO
new].COURSE) AND ([tblSchool Schedule new].CLASS = "
strSQL = strSQL & "[tblACO new].CLASSNO) AND ([tblSchool
Schedule new].COURSE = tblGradRoster.COURSE) AND "
strSQL = strSQL & "([tblSchool Schedule new].CLASS =
tblGradRoster.CLASSNO) "
strSQL = strSQL & "WHERE ((([tblACO new].SSN)= " & iSSN & "));"

Debug.Print strSQL

Set rst = CurrentDb.OpenRecordset(strSQL)

With rst
If Nz(.Fields("MI")) = "" Then
If Nz(.Fields("SUFFIX")) = "" Then
strName = Nz(.Fields("LONG TITLE")) & " " &
Nz(.Fields("FNAME")) & " " & Nz(.Fields("LNAME")) & " XXX XX " &
Nz(.Fields("LAST4")) & "/" & Nz(.Fields("PMOS"))
Else
strName = Nz(.Fields("LONG TITLE")) & " " &
Nz(.Fields("FNAME")) & " " & Nz(.Fields("LNAME")) & " " &
Nz(.Fields("SUFFIX")) & " XXX XX " & Nz(.Fields("LAST4")) & "/" &
Nz(.Fields("PMOS"))
End If
Else
If Nz(.Fields("SUFFIX")) = "" Then
strName = Nz(.Fields("LONG TITLE")) & " " &
Nz(.Fields("FNAME")) & " " & Nz(.Fields("MI")) & " " & Nz(.Fields("LNAME")) &
" XXX XX " & Nz(.Fields("LAST4")) & "/" & Nz(.Fields("PMOS"))
Else
strName = Nz(.Fields("LONG TITLE")) & " " &
Nz(.Fields("FNAME")) & " " & Nz(.Fields("MI")) & " " & Nz(.Fields("LNAME")) &
" " & Nz(.Fields("SUFFIX")) & " XXX XX " & Nz(.Fields("LAST4")) & "/" &
Nz(.Fields("PMOS"))
End If
End If
strCOURSE = Nz(.Fields("TITLE"))
strCOURSE1 = Nz(.Fields("TITLE"))
strCOURSE2 = Nz(.Fields("TITLE"))
strCLASSNO = Nz(.Fields("CLASSNO"))
strDAY = Nz(.Fields("GRADUATE"))
strMONTH = Nz(.Fields("GRADUATE"))
strYEAR = Nz(.Fields("GRADUATE"))
strACE = Nz(.Fields("CE ID"))
strCID = Nz(.Fields("CID"))
strVERSION = "Version " & Nz(.Fields("VERSION")) & ": " &
Mid$(strCID, 4, 3)
strLENGTH = Nz(.Fields("LENGTH"))
strEXHIBIT = Nz(.Fields("EXHIBIT"))
strLEARNING = Nz(.Fields("LEARNING"))
strINST = Nz(.Fields("INST"))
strCRED = Nz(.Fields("CRED"))
strCREDIT = Nz(.Fields("CREDIT"))
strCREDIT1 = Nz(.Fields("CREDIT1"))
strCREDIT2 = Nz(.Fields("CREDIT2"))
strCREDIT3 = Nz(.Fields("CREDIT3"))
strCREDIT4 = Nz(.Fields("CREDIT4"))
strCREDIT5 = Nz(.Fields("CREDIT5"))
strCREDIT6 = Nz(.Fields("CREDIT6"))
strMILGUIDE = Nz(.Fields("MILGUIDE"))
strMILGUIDEWEB = Nz(.Fields("MILGUIDEWEB"))
strREVISION = Nz(.Fields("REVISION"))
.Close
End With
strDAY = Format(strDAY, "d")
strMONTH = Format(strMONTH, "MMMM")
strYEAR = Format(strYEAR, "yyyy")
If strDAY = "1" Or strDAY = "21" Or strDAY = "31" Then
strDAYext = "st"
ElseIf strDAY = "2" Or strDAY = "22" Then
strDAYext = "nd"
ElseIf strDAY = "3" Or strDAY = "23" Then
strDAYext = "rd"
Else
strDAYext = "th"
End If
strName = UCase(strName)
strCOURSE = UCase(strCOURSE)
strCOURSE1 = UCase(strCOURSE1)
strCOURSE2 = UCase(strCOURSE2)

On Error Resume Next
Set objWord = GetObject(, "Word.application")
If err = 429 Then
Set objWord = New Word.Application
End If

On Error GoTo 0

With objWord
.Visible = True
If Me.optCO Then
'Set doc = .Documents.Add("X:\Company dbase\Blank
Forms\DIPLOMAsigned.dot")
Else
Set doc = .Documents.Add("X:\Company dbase\Blank
Forms\DIPLOMA.dot")
End If
' Fill the above Word Template with the below bookmarks
information
With doc.Bookmarks
.Item("DAY").Range.Text = strDAY
.Item("DAYext").Range.Text = strDAYext
.Item("CLASSNO").Range.Text = strCLASSNO
.Item("MONTH").Range.Text = strMONTH
.Item("NAME").Range.Text = strName
.Item("COURSE").Range.Text = strCOURSE
.Item("YEAR").Range.Text = strYEAR
.Item("ACE").Range.Text = strACE
.Item("CID").Range.Text = strCID
.Item("VERSION").Range.Text = strVERSION
.Item("COURSE1").Range.Text = strCOURSE1
.Item("COURSE2").Range.Text = strCOURSE2
.Item("LENGTH").Range.Text = strLENGTH
.Item("EXHIBIT").Range.Text = strEXHIBIT
.Item("LEARNING").Range.Text = strLEARNING
.Item("INST").Range.Text = strINST
.Item("CRED").Range.Text = strCRED
.Item("CREDIT").Range.Text = strCREDIT
.Item("CREDIT1").Range.Text = strCREDIT1
.Item("CREDIT2").Range.Text = strCREDIT2
.Item("CREDIT3").Range.Text = strCREDIT3
.Item("CREDIT4").Range.Text = strCREDIT4
.Item("CREDIT5").Range.Text = strCREDIT5
.Item("CREDIT6").Range.Text = strCREDIT6
.Item("MILGUIDE").Range.Text = strMILGUIDE
.Item("MILGUIDEWEB").Range.Text = strMILGUIDEWEB
.Item("REVISION").Range.Text = strREVISION
.Item("SIGN").Range.Text = strSIGN
End With
End With

objWord.Activate
End If
mysetgrad.MoveNext
If mysetgrad.EOF Then
Exit Do
End If
iSSN = mysetgrad![SSN]
Loop
End If

 

[Jack Cannon]

I agree with Ken. While bookmarks will accomplish the objective, they are
not very efficient. And as you have noted it is an errorprone process that
can be time-consuming if a change is required. It also becomes a big
headache when additional documents must be created.

I have used the temporary text file approach as Ken suggested which is
efficient and works fine but I have found that a better approach (at least
for me) is to use a dedicated table (tblMailMerge) as the source for the
MailMerge operation. The advantage of a dedicated table is that it reduces
the amount of code that must be created for every possible document. Many
fields are redundant between documents ([FullName], [Address], etc.) If you
need an additional field just add it to the dedicated table. Then it is just
a matter of loading the appropriate fields for the document of concern.
Unused fields are ignored during the MailMerge operation.

Do not put the additional table in the BackEnd. Someone else may want to
use it at the same time that you use it. Put it either in the FrontEnd or
(as I do) in another Access file that resides on each user machine. I prefer
the second file approach because it also contains various other tables that
are used for individual customization purposes. Furthermore it does not
require a login to access the data.

There is also another advantage of using MailMerge instead of bookmarks. If
you have a paper jam in the middle of the printing process, then it is just a
matter of editing the text file or dedicated table to reprint the records of
concern. After such editing the print process can continue by simply
starting it from Word instead of Access. The use of bookmarks may require
the user to restart the entire operation.

Jack Cannon