MailMerge in 3D

[Steven Packard]

I know someone has done this before but I cannot figure it
out. I am trying to create a mailmerge template that will
generate a letter to each of my clients outlining the
services I have performed for them over a given period of
time. Conceptually, it is analogous to a letter going to
each customer outlining the purchase orders. All I can
see mailmerge doing is giving me a 2
dimensional "recordset" and performing the mailmerge based
on the name and address of my client list. How do I get
the line item details (I have a one to many relationship
established in my database). I want to be able to put the
name and address of my client at the top of the letter,
and the line items in the body in a table. I would like to
do this as a mailmerge rather than through automation and
ADO because I do not know how to duplicate the mailmerge
functionality of iterating through a recordset and adding
new instances of the same template within the same
document. I think I would have to open a new document for
each record in my recordset. With a hundred or more
records in my recordset, I am afraid there would be too
many problems.

 

[Doug Robbins]

Better done with a report in Access. However you may be able to modify the
following to do what you want or

See the "Multiple items per condition" item under the "Special merges"
section of fellow MVP CIndy Meister's website at

http://homepage.swissonline.ch/cindymeister/MergFram.htm



' Macro to create multiple items per condition in separate tables from a
directory type mailmerge

Dim source As Document, target As Document, scat As Range, tcat As Range

Dim data As Range, stab As Table, ttab As Table

Dim i As Long, j As Long, k As Long, n As Long

Set source = ActiveDocument

Set target = Documents.Add

Set stab = source.Tables(1)

k = stab.Columns.Count

Set ttab = target.Tables.Add(Range:=Selection.Range, numrows:=1,
numcolumns:=k - 1)

Set scat = stab.Cell(1, 1).Range

scat.End = scat.End - 1

ttab.Cell(1, 1).Range = scat

j = ttab.Rows.Count

For i = 1 To stab.Rows.Count

Set tcat = ttab.Cell(j, 1).Range

tcat.End = tcat.End - 1

Set scat = stab.Cell(i, 1).Range

scat.End = scat.End - 1

If scat <> tcat Then

ttab.Rows.Add

j = ttab.Rows.Count

ttab.Cell(j, 1).Range = scat

ttab.Cell(j, 1).Range.Paragraphs(1).PageBreakBefore = True

ttab.Rows.Add

ttab.Cell(j + 1, 1).Range.Paragraphs(1).PageBreakBefore = False

For n = 2 To k

Set data = stab.Cell(i, n).Range

data.End = data.End - 1

ttab.Cell(ttab.Rows.Count, n - 1).Range = data

Next n

Else

ttab.Rows.Add

For n = 2 To k

Set data = stab.Cell(i, n).Range

data.End = data.End - 1

ttab.Cell(ttab.Rows.Count, n - 1).Range = data

Next n

End If

Next i


--
Please respond to the Newsgroup for the benefit of others who may be
interested. Questions sent directly to me will only be answered on a paid
consulting basis.

Hope this helps,
Doug Robbins - Word MVP