VBA Code to Split & Save Mail Merge

[beginner145]

Hi,

I currently have a mail merge template set up with a macro that will merge and shade relevant parts of a table once the information from a csv file is merged into it.

However, there are a couple of improvements which I would like to make to it, but I have no idea of how to code it into the existing coding.

If I attach the data file and run the macro, it will merge the entire file into one document. To create a file for each polling district, What I end up doing is filtering in the Mail Merge Recipients options and selecting an individual polling district, then running the macro and using Save As to manually save the merged document.

To save me having to do this, I would like to be able to attach the data source and have the macro merge and create a document for each polling district and have it save the file with the filename of the polling district. It may also help to prompt for the macro to ask where to save the documents produced (the location would change each year and it would save editing the macro each time).

Is any of this at all possible? :-)

The macro is currently:
Sub TableShader()
Application.ScreenUpdating = False
Dim Tbl As Table, oCell As Cell, bShd As Boolean, Rng As Range, StrTxt As String
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
For Each Tbl In ActiveDocument.Tables
StrTxt = "": bShd = False
With Tbl.Range
For Each oCell In .Cells
With oCell
If .ColumnIndex = 1 Then
Set Rng = .Range
With Rng
.End = .End - 1
.Start = .Words.Last.Start
End With
If Rng.Text = StrTxt Then
bShd = True
Else
bShd = False
StrTxt = Rng.Text
End If
End If
If Not IsNumeric(Rng.Text) Then bShd = False
If bShd = True Then
If .ColumnIndex = 2 Then
.Shading.BackgroundPatternColor = RGB(255, 234, 218)
On Error Resume Next
Tbl.Cell(.RowIndex - 2, .ColumnIndex).Shading.BackgroundPatternColor = RGB(255, 234, 218)
On Error GoTo 0
End If
End If
If .ColumnIndex = 3 Then
Set Rng = .Range
With Rng
.End = .End - 1
End With
Select Case Rng.Text
Case "HEF": .Shading.BackgroundPatternColor = RGB(235, 241, 222)
Case "ITR": .Shading.BackgroundPatternColor = RGB(230, 224, 236)
Case "ITR-NR": .Shading.BackgroundPatternColor = RGB(230, 224, 236)
End Select
End If
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub

[macropod]

There are two ways of addressing this issue:
• automate the mailmerge to generate separate output documents as it runs;
• do the mailmerge manually, then split the output document post-merge.
For code to do both, see:
• Send Mailmerge Output to Individual Files; and
• Split Merged Output to Separate Documents,
in the Mailmerge Tips and Tricks threads at:
http://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
&:
http://windowssecrets.com/forums/showthread.php/163017-Word-Mailmerge-Tips-amp-Tricks
You could add your table-shading code to either.

[beginner145]

Hi Macropod,

Thanks for the information.

The number of entries in each polling district will vary and I would like one file per polling district. If I use the following macro, which part do I change so that for example when the value in the polling district field changes from AA01 to AA02 that knows to save AA01 and then create AA02 and so on.

Sub Merge_To_Individual_Files()
'Merges one record at a time to the folder containing the mailmerge main document.
' Sourced from: http://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument
With MainDoc
StrFolder = .Path & Application.PathSeparator
For i = 1 To .MailMerge.DataSource.RecordCount
With .MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
If Trim(.DataFields("POLLING_DISTRICT")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & Application.PathSeparator
StrName = .DataFields("POLLING_DISTRICT")
End With
.Execute Pause:=False
End With
For j = 1 To Len(StrNoChr)
StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = Trim(StrName)
With ActiveDocument
.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Next i
End With
Application.ScreenUpdating = True
End Sub

[macropod]

If you have varying numbers of records per group, that particular macro won't work, as it's designed for letter merges. That said, if your output format is suitable, you could use a DATABASE field to group the data and a macro to drive the process. For an example of that approach, see my post of January 10, 2016 in: http://answers.microsoft.com/en-us/office/forum/office_2010-word/many-to-one-email-merge-using-tables/8bce1798-fbe8-41f9-a121-1996c14dca5d. Alternatively, you might try one of the Many-to-One Mail Merge add-ins, from:
Graham Mayor at http://www.gmayor.com/ManyToOne.htm; or
Doug Robbins at http://bit.ly/1hduSCB

[beginner145]

At the moment the moment the mail merge template file is set up as a Directory. The table headings are in the header of the document. The main document contains one table row.

The first three columns are contain mergefields - the remaining 5 columns don't contain any mergefields (however, the fourth column is split horizontally). Each entry in my data will have a row like this.

How would I use DATABASE field to produce this?

Thanks

[macropod]

Did you read the content in the link I posted? For a demonstration of the use of a DATABASE field with an Excel data source (though not in a mailmerge context), see: http://www.msofficeforums.com/mail-merge/21847-mail-merge-into-different-coloumns.html#post67097

[beginner145]

I did, but I don’t really understand it.

[macropod]

It pays to study the content closely, plus Microsoft's documentation on the DATABASE field. See: https://support.office.com/en-us/article/Field-codes-Database-field-04398159-a2c9-463f-bb59-558a87badcbc

[beginner145]

I can use this coding:

{QUOTE{IF{MERGESEQ}=1{Set Key ""}}"{IF{MERGEFIELD POLLING_DISTRICT}<>{REF Key \* MERGEFORMAT } "{IF{MERGESEQ}> 1 ""}(THEN I'VE INSERTED A PAGE BREAK){SET Key{MERGEFIELD POLLING_DISTRICT}}" }{ MERGEFIELD "POLLING_DISTRICT" }
{MERGEFIELD "FULL_NAME" }
ELECTOR ID - { MERGEFIELD ELECTOR_ID }
HOUSE ID - { MERGEFIELD "HOUSE_ID" }

However, it works when not used in a table, but not when used in a table. Also, it inserts a page break straight away giving a blank page first.

[macropod]

Aside from not needing the \* MERGEFORMAT switch, the code works if you embed a table row in the field code. However, the output will contain separate 1-row tables that will need to be re-joined. The field code you've posted is evidently derived from my Microsoft WordCatalogue/Directory Mailmerge Tutorial, available at:
http://windowssecrets.com/forums/showthread.php/154370-Microsoft-Word-Catalogue-Directory-Mailmerge-Tutorial
&:
http://www.gmayor.com/Zips/Catalogue%20Mailmerge.zip
The tutorial includes examples for table generation; indeed it covers everything from list creation to the insertion & calculation of values in multi-record tables in letters. Do read the tutorial before trying to use the mailmerge document included with it. Properly implemented, you won't get an empty page at the start.

The issue you'll have, though, is that the processes described in the tutorial won't output a separate file for each group. The process using the DATABASE field can easily be adapted to do that.