Mail Merge Multiple Word templates into 1

[Revolution1200]

Hi All,

We have multiple word document templates that we use for merging purposes - this is due to people being assigned different letters in the database depending on processing.

We need to merge these into one final document for mailing.

The data for this comes from an excel spreadsheet which has the following format

Field 1 - Letter Identifier to use
Field 2 - Title
Field 3 - Initials
Field 4 - Surname
Field 5 - Address details

My current solution involves opening all the templates required
Open a new document to merge to

For each record
Select the template Required
Copy template to new document
Change each merge field to the data from the record
Add a page break
Next Record

The problem is that this is very slow, can anyone tell me if there is a way to do this using the mail merge within word?

Thanks

Stuart

 

[SkipVought]

Does each template use the same source data?

If so, copy 'n' paste the various merge document pages into ONE merge document.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Revolution1200]

Hi Skip,

A template may only merge to one of the records in the source data depending on the letter the customer is to get.

The copy 'n' paste is the method i am currently using - amending the merge fields to my data as I go, trouble is this is very slow.

Cheers

Stuart

 

[SkipVought]

The Copy 'n' Paste would occur ONE TIME.

Or I do not understand your actual problem.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[macropod]

Hi Stuart,

Given that you have:
Field 1 - Letter Identifier
You could simply create a single mailmerge main document that uses SKIPIF fields keyed to Field 1 to skip any records that don't have the appropriate identifier. Further IF fields in the mailmerge main document can be used to vary the text according to the letter type indicated by Field 1.


Cheers
[MS MVP - Word]

 

[Revolution1200]

I may not have explained this very well.

The records in the excel file are in an order that cannot be changed - for mailsort purposes, they need to be merged to 1 single document which will be a collection of a number of templates depending on the letter identifier.

My current code is as follows (I should have posted this first)

    Dim oSR As Word.Range
    Dim oFld As Word.Field
    Dim oRange As Word.Range
    Dim szField() As String
    Dim lState As Long
    Dim mainApplication As Excel.Application
    Dim path As String
    Dim ado, rs
    Dim numLetters As Integer
    Dim loadedLetters As Integer
    Dim change As Boolean
    Dim newData As String
    Dim oMySR As Word.Range
    Dim oMyField As Word.Field
    Dim currRecord As Long
    Dim i As Integer
        
    'open our spreadsheet and get a count of distinct letters used
    path = "C:\N_LET0304_356.xls"
    Set ado = CreateObject("ADODB.Connection")
    ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Extended Properties=Excel 8.0;Persist Security Info=False"
    ado.Open
    Set rs = ado.Execute("SELECT Distinct LETTER FROM [N_LET0304_356$]")
    numLetters = 0
    While Not rs.EOF
        numLetters = numLetters + 1
        rs.MoveNext
    Wend
    rs.Close
    
    'create our word application
    Set wordapp = New Word.Application
    Do While wordapp = ""
        Set wordapp = New Word.Application
        i = i + 1
        If i = 5 Then
            MsgBox "Error creating word object - form will close"
        End If
    Loop
    
    'for testing
    wordapp.Visible = False
    wordapp.ScreenUpdating = False
    
    'now load our letter templates that we require
    ReDim doc2(numLetters)
    loadedLetters = 0
    Set rs = ado.Execute("SELECT DISTINCT LETTER FROM [N_LET0304_356$]")
    While Not rs.EOF
        Set doc2(loadedLetters) = wordapp.Documents.Open(fileName:="C:\Dayend Letters\" & rs.Fields(0) & ".doc", _
            ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
            PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
            WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
            wdOpenFormatAuto)
            
        rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
    
    'for testing
    wordapp.Visible = False
    
    Set doc1 = wordapp.Documents.Add
    Set doc3 = wordapp.Documents.Add
    currRecord = 1
    Label4.Caption = CStr(currRecord)
    
    'ok our main loop - run through the records
    Set rs = ado.Execute("SELECT * FROM [N_LET0304_356$]")
    While Not rs.EOF
            
        'delete any text currently in our working document
        wordapp.Windows("Document2").Activate
        wordapp.Selection.WholeStory
        wordapp.Selection.TypeBackspace
        wordapp.Selection.TypeBackspace
        wordapp.Selection.Delete Unit:=wdCharacter, count:=1
        
        'now we need to select the correct template and copy the details to Doc3 ready to setup the merge
        wordapp.Windows(CStr(Trim(rs.Fields(0)) & ".doc")).Activate
        wordapp.Selection.WholeStory
        wordapp.Selection.Copy
        wordapp.Windows("Document2").Activate
        wordapp.Selection.PasteAndFormat (wdPasteDefault)
        wordapp.Selection.TypeBackspace

        'this section adds our details
        'For Each oSR In doc3.StoryRanges
        Set oSR = doc3.StoryRanges(1)
        
            For Each oFld In oSR.Fields
                  
            ' the "wordfield.code" is in the format "MERGEFIELD fieldname". Use the
            ' SPLIT command (with space as the field delimeter) to put the two or more values
            ' into an array, and the merge field name will be in element 2 of the
            ' array.
            
            If (Left(oFld.Code, Len(" MERGEFIELD")) = " MERGEFIELD") Then
                szField = Split(oFld.Code, " ")
                change = False
                newData = ""
                szField(2) = Replace(szField(2), Chr(34), "", , , vbBinaryCompare)
                Select Case LCase(szField(2))
                    Case "title"
                        change = True
                        newData = rs.Fields(1) & vbNullString
                    Case "initials"
                        change = True
                        newData = rs.Fields(2) & vbNullString
                    Case "surname"
                        change = True
                        newData = rs.Fields(3) & vbNullString
                    Case "a1"
                        change = True
                        newData = rs.Fields(4) & vbNullString
                    Case "a2"
                        change = True
                        newData = rs.Fields(5) & vbNullString
                    Case "a3"
                        change = True
                        newData = rs.Fields(6) & vbNullString
                    Case "a4"
                        change = True
                        newData = rs.Fields(7) & vbNullString
                    Case "a5"
                        change = True
                        newData = rs.Fields(8) & vbNullString
                    Case "a6"
                        change = True
                        newData = rs.Fields(9) & vbNullString
                    Case "a7"
                        change = True
                        newData = rs.Fields(10) & vbNullString
                    Case "ref1"
                        change = True
                        newData = rs.Fields(11) & vbNullString
                    Case "ref2"
                        change = True
                        newData = rs.Fields(12) & vbNullString
                    Case "ref3"
                        change = True
                        newData = rs.Fields(13) & vbNullString
                End Select
                
                If change Then
                    oFld.Select
                    Set oRange = wordapp.Selection.Range
                    'oRange.Text = Format(Date, "DD MMMM YYYY")
                    oRange.Text = newData
                End If
            End If
            Next
        'Next
        
        'now copy all the data over to the bottom of doc1
        wordapp.Selection.WholeStory
        wordapp.Selection.Copy
        wordapp.Windows("Document1").Activate
        wordapp.Selection.PasteAndFormat (wdPasteDefault)
        wordapp.Selection.TypeBackspace
        wordapp.Selection.InsertBreak Type:=wdPageBreak
        
        rs.MoveNext
        currRecord = currRecord + 1
        Label4.Caption = CStr(currRecord)
    Wend
    
    rs.Close
    Set rs = Nothing
    ado.Close
    Set ado = Nothing
 
    wordapp.Windows("Document1").Activate
    wordapp.ActiveDocument.SaveAs "C:\testfile.doc"
 
    wordapp.Quit False
    Set wordapp = Nothing

 

[SkipVought]

depending on the letter identifier.

What is that identifier and what is the logic that determines the fields to use for each?

Is this data relationship in a table?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Revolution1200]

Hi Skip,

The identifier is the first field in the excel spreadsheet and is basically the name of the word template to use.

Example records would be

identifier name address details
template1 test name some address
template2 test name some address 2
template1 test name some address 3

The order of the records has to be the same in the final document as it is in the spreadsheet.

Logic is basically

Select all records from the spreadsheet

For each record determine the template to use
merge the fields and copy this to the final document
next record

Cheers

Stuart

 

[SkipVought]

The order of the stored data is totally irrelevent.

When you select data, there is an opportunity to FILTER the source data for the merge. You can also 'go back' and choose another filter, which would be your Identifier.

Pretty simple, it seems to me.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Revolution1200]

Hi,

The order is important as the final merged document must be made up in the order of

Template1
Template2
Template1

This is due to when we print the single final letter it is in the correct mailsort order

 

[SkipVought]

OK ZIP order perhaps.

Does that seem doable to you?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[macropod]

Hi Stuart,

It seems tome you're making this a whole lot more complicated than it needs to be. So far, nothing you've described requires ANY vba. It can all be done using a standard Word mailmerge, with IF fields to control the content (and a SKIPIF field if you want to control which template's records are output), and sorting the records according to the template field's contents.


Cheers
[MS MVP - Word]

 

[Revolution1200]

Thanks Macropod,

I will have a look at the IF again, i think the thing that put me off this is that we have around 50 Merge templates that may need to be combined into the final document.

Cheers

Stuart

 

[macropod]

Hi Stuart,

With so many mailmerge main documents, which you call templates (your previous posts only referred to a few - AFAIK you only mentioned 2), it may be best to keep them separate for ease of maintenance, regardless of whether you're using vba or field coding. Conversely, if some of these are just minor variations on a theme, combining the variants with the use of IF fields could greatly simplify things (even if you're using vba to drive the overall process).


Cheers
[MS MVP - Word]

 

[Revolution1200]

Thanks Skip and Macropod for your help with this.

Probably my fault as I only showed a couple of record examples.

The actual record file can have > 4000 records to merge.

I have managed to come up with a quicker solution with a variation of the above code by running through the records and adding each template to a new document in the correct order, i then add the next merge field.

once i have 100 records in a file i start a new file.

Once i have all these files i combine them into a final merge file and use the word mail merge to merge a final document.

Not the most elegant of solutions but my co-workers are happy with it.

Cheers

Stuart

 

[macropod]

Hi Stuart,

It's not the number of records that were of any particular concern, but the number of 'templates'. Minimising the number of 'templates' (eg by using IF fields to handle minor variations) that have to be opened could achieve significant efficiencies.


Cheers
[MS MVP - Word]