Word Mail Merge with Excel data has to be saved in different files with custom names

Question

I have a very unique issue: I have an Excel worksheet with tonnes of data and a letter written in Word. I have to use the data from the worksheet in a Mail Merge in Word. The issue is that each Mail Merge must be saved as a separate Word file, and each file must be saved with a name derived from the Mail Merge's input data.

For instance, my Excel spreadsheet has a table with three columns labelled Name, Surname, and Birthday. Ten rows make up this table. I must use Mail Merge in Word to add the recipient's name, last name, and birthday. Each Mail Merge must be saved in a separate file, which means that in the end, there will be 10 files total—one for each row. Every file needs to have the relative Surname taken from the Mail Merge as the name. 

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 can save every Mail Merge exactly like I need to. The only problem is that a filename is a number like 0001, 0002, etc.; I need to set that name to a value I store in the Excel Worksheet and use in the Mail Merge.

Answer 1

Try this:

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