Office 2013 - Excel to Word mail merge - each record saves as separate file name determined by two fields

Posted on 2013-06-20
Last Modified: 2013-06-29

I have an Excel 2013 source file, and a Word 2013 template that I am trying to merge, with each record creating a new Word document, using a combination of two of the fields in each record.

I have tried to adapt and use 4 different vba scripts found in similar threads and on other sites, with none of them working so far. I've spent several days making sure I followed instructions for each one precisely, and I guess I need help specific to my task and programs (the other solutions I tried were designed in earlier versions of Word; I don't know if that makes a difference or not).

Attached are the source data spreadsheet and the Word template. I already tried the solution where the first line is set to heading1 style with a page break at the end, and I kept getting "The selection does not consist of heading levels" error message no matter what I tried.

I need each record to merge into the template and save as "<<DISTRICTNAME>> - <<COSMID>>.docx", for a total of 534 word docs created.

Does anyone know of a solution that will work for me? Many thanks in advance..
Question by:shawnhaning
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
LVL 52

Expert Comment

ID: 39265263
Pls try

Put the code in  the ThisDocument Module
Dim WithEvents wdapp As Application
Dim bCustomProcessing As Boolean

Private Sub Document_Open()

Set wdapp = Application
bCustomProcessing = False
ThisDocument.MailMerge.DataSource.ActiveRecord = 1
ThisDocument.MailMerge.ShowWizard 1
With ActiveDocument.MailMerge
   If .MainDocumentType = wdFormLetters Then
       .ShowSendToCustom = "Custom Letter Processing"
   End If
End With

End Sub
Private Sub wdapp_MailMergeWizardSendToCustom(ByVal Doc As Document)

bCustomProcessing = True
Doc.MailMerge.Destination = wdSendToNewDocument
With Doc.MailMerge
    For rec = 1 To .DataSource.RecordCount
        .DataSource.ActiveRecord = rec
        .DataSource.FirstRecord = rec
        .DataSource.LastRecord = rec
End With

MsgBox "Merge Finished"
End Sub

Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
If bCustomProcessing = True Then
    With Doc.MailMerge.DataSource.DataFields
        sFileName = .Item(1).Value & " - " & .Item(2).Value
    End With
    DocResult.SaveAs sFileName, wdFormatXMLDocument
    DocResult.Close False
End If
End Sub

Open in new window

and use Custom Letter Processing at step 6 from Mailmerge wizard


Author Comment

ID: 39266240

Thanks for your response!
I copied the code you provided into the ThisDocument module, but I do not see Custom Letter Processing option at step 6 in the Mail Merge wizard (screenshot). What am I missing?

mail merge wizard screenshot
LVL 52

Expert Comment

ID: 39267971

Have you saved the Template and re-opened it

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Author Comment

ID: 39271724
Yes I saved it as a macro-enabled template with the code and re-opened it. Still did not work.
LVL 52

Expert Comment

ID: 39271905

pls refer to

If you follow the instructuions it should resolve your problem

'purpose: save each letter generated after mail merge in a separate file
'         with the file name equal to first line of the letter.
'1. Before you run a mail merge make sure that in the main document you will 
'   end your letter with a Section Break (this can be found under 
'   Page Layout/Breaks/Section Break Next Page)
'2. Furthermore the first line of your letter contains the proposed file name
'   and put an enter after it. Make the font of the filename white, to make it 
'   is invisible to the receiver of the letter. You can also include a folder 
'   name if you like.
'3. Run the mail merge as usual. A file which contains all the letters is 
'   generated.
'4. Add this module to the generated mail merge file. Use Alt-F11 to go to the 
'   visual basic user interface, right click in the left pane on the generated
'   file and click on Import File and import this file
'5. save the generate file with all the letters as ‘Word Macro Enabled doc 
'   (*.docm)’.
'6. close the file.
'7. open the file again, click allow content when a warning about macro's is 
'   shown.
'8. execute the macro with the name SaveRecsAsFiles

Sub SaveRecsAsFiles()
    ' Convert all sections to Subdocs
    AllSectionsToSubDoc ActiveDocument
    'Save each Subdoc as a separate file
    SaveAllSubDocs ActiveDocument
End Sub

Private Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
    Dim secCounter As Long
    Dim NrSecs As Long
    NrSecs = doc.Sections.Count
    'Start from the end because creating
    'Subdocs inserts additional sections
    For secCounter = NrSecs - 1 To 1 Step -1
        doc.Subdocuments.AddFromRange _
    Next secCounter
End Sub

Private Sub SaveAllSubDocs(ByRef doc As Word.Document)
    Dim subdoc As Word.Subdocument
    Dim newdoc As Word.Document
    Dim docCounter As Long
    Dim strContent As String, strFileName As String

    docCounter = 1
    'Must be in MasterView to work with
    'Subdocs as separate files
    doc.ActiveWindow.View = wdMasterView
    For Each subdoc In doc.Subdocuments
        Set newdoc = subdoc.Open
        'retrieve file name from first line of letter.
        strContent = newdoc.Range.Text
        strFileName = Mid(strContent, 1, InStr(strContent, Chr(13)) - 1)
        'Remove NextPage section breaks
        'originating from mailmerge
        RemoveAllSectionBreaks newdoc
        With newdoc
            .SaveAs FileName:=strFileName
        End With
        docCounter = docCounter + 1
    Next subdoc
End Sub

Private Sub RemoveAllSectionBreaks(doc As Word.Document)
    With doc.Range.Find
        .Text = "^b"
        With .Replacement
            .Text = ""
        End With
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Open in new window


Accepted Solution

shawnhaning earned 0 total points
ID: 39272274
I have tried to adapt and use 4 different vba scripts found in similar threads and on other sites, with none of them working so far. I've spent several days making sure I followed instructions for each one precisely

The stackoverflow solution was the first one I tried, many times, making sure I followed the instructions precisely, and it did not work for me.

However, I did run across a solution that was actually much easier! No VB code required. All I had to do was make the first line of the template = the filename I wanted it to be, and then color that white (invisible). Then I ran the merge and created one large Word doc and followed the instructions from this video. Problem solved.

Author Closing Comment

ID: 39286398
One of my developer friends at work discovered that youtube video that solved the problem perfectly. I just wanted to post it in case someone else had the same issue.

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

631 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question