Search code examples
excelvbams-wordmailmerge

Word Mail Merge with Excel data has to be saved in files with custom names based on cell value


I have a letter written in Word and a worksheet full of data in Excel.
I need to do a Mail Merge in Word that uses the worksheet's data.

The problem is every Mail Merge has to be saved as a different Word file and, also, every file has to be saved with a name from the data used in the Mail Merge.

For example:
My Excel has a table with 3 columns called Name, Surname, Birthday. This table has 10 rows.
I need to do the Mail Merge in Word with Name, Surname and Birthday.
Every Mail Merge has to be saved in a different file (in the end, we'll have 10 files, 1 for each row).
Every file has to be named as the relative Surname extracted from the Mail Merge.

I found this VBA code online and tried it in Word:

' Modulo1 - Modulo'

Option Explicit

Public Sub Test()

On Error GoTo ErrH

Dim mm As Word.MailMerge
Dim i

Application.ScreenUpdating = False

Set mm = ThisDocument.MailMerge
With mm
    .Destination = wdSendToNewDocument
    With .DataSource
        For i = 1 To .RecordCount
            .FirstRecord = i
            .LastRecord = i
            mm.Execute
            With Application.ActiveDocument
                .SaveAs "C:\Users\Alessandro\Desktop\excel udine\TRIESTE\" & Format(i, "0000") _
                  , wdFormatDocument _
                  , AddToRecentFiles:=False
                .Saved = True
                .Close
            End With
        Next
    End With
End With

ExitProc:
    Application.ScreenUpdating = True
    Set mm = Nothing
    Exit Sub

ErrH:
    MsgBox Err.Description
    Resume ExitProc

End Sub

This code saves every Mail Merge. The problem is that the filename is a number like 0001, 0002, etc.
I need to set that name to a value I store in the Excel Worksheet and also use in the Mail Merge.


Solution

  • I managed to find a solution to my own problem. I still don't know why I couldn't make work the old code, but this code works perfectly:

    Public Sub Mail_Merge()
    
    On Error GoTo ErrH
    
    Dim mm As Word.MailMerge
    Dim singleDoc As Document
    Dim i
    Dim nameFile As String
    Dim path As String
    
    path = "WRITE PATH TO SAVE FILE"
    nameFile = "WRITE COLUMN NAME FROM MAIL MERGE"
    
    Application.ScreenUpdating = False
    
    Set mm = ThisDocument.MailMerge
    
    mm.DataSource.ActiveRecord = wdFirstRecord
    
    For i = 1 To mm.DataSource.RecordCount
        mm.Destination = wdSendToNewDocument
    
        mm.DataSource.FirstRecord = mm.DataSource.ActiveRecord
        mm.DataSource.LastRecord = mm.DataSource.ActiveRecord
        
        mm.Execute False
    
        Set singleDoc = ActiveDocument
    
        singleDoc.SaveAs2 _
            FileName:=path & mm.DataSource.DataFields(nameFile).Value, _
            FileFormat:=wdFormatDocumentDefault, _
            AddToRecentFiles:=False
    
        singleDoc.Close False
    
        mm.DataSource.ActiveRecord = wdNextRecord
    Next
    
    ExitProc:
        Application.ScreenUpdating = True
        Set mm = Nothing
        Exit Sub
       
    ErrH:
        MsgBox Err.Description
        Resume ExitProc
       
    End Sub