VBA Mail Merge using multiple data sources and mixture of single item and repeating rows fields

[Saeed]

I am newbie to VBA, and would like to know if the following can be done
using VBA with Word.

A word document is to be used as a report template. The users may amend
the "boilerplate text" to their tastes, but not the merge data place
holders (terminology?).

The document is a mixed of single items and repeating row items, as
illustrated by the following example:

OWNER: _THE_OWNER_
ADDRESS: _THE_ADDRESS_

RESIDENTS
NAME DOB GENDER
_THE_NAME_ _THE_DOB_ _THE_GENDER_
(repeated for each database row)

RESIDENCE LAYOUT
ROOM SIZE USAGE HEATED DOUBLE GLAZED
_THE_ROOM_ _THE_SIZE_ _THE_USAGE_ _THE_HEATED_ _THE_DOUBLE_GLAZED_
(repeated for each database row)

INSPECTION NOTES: _THE_INSPECTION_NOTES_
INSPECTED BY: _THE_INSPECTED_BY_
INSPECTION DATE: _THE_INSPECTION_DATE_

All items in relate to a single database row other than those in the
tables marked above as "repeated for each database row".

I cannot use normal Word Mail Merge because I need 3 data sources, 1 for
the single items and one for each table above - I could use mail merge
if I flattened the returned data out to make a single data source, but
that would be well messy and there has to be a neater way.

Having searched the internet for info I have concluded that this can be
done using VBA, but what I need is an example of such a mail merge that
I can use as a proof of concept for input into the design stage.

I am using Office 2000.


Saeed

ng_786

 

[Doug Robbins]

If you did flatten the datasource, you could build on the following:

' 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