The following will work, however may I suggest you look at the merge to documents mode of
E-Mail Merge Add-in
Code:
Option Explicit
Sub SaveIndividualWordFiles()
Dim i As Long
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String, sFName As String
Set docMail = ActiveDocument
savePath = docMail.path & "\"
With docMail.MailMerge
For i = 1 To .DataSource.RecordCount
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
'' This will be the file name
'' the test data source had unique surnames
'' in a field (column) called FileName
sFName = .DataFields("Title").value
End With
.Execute Pause:=False
Set docLetters = ActiveDocument
' Save generated document and close it after saving
docLetters.SaveAs FileName:=savePath & sFName & ".docx"
docLetters.Close False
DoEvents
Next
End With
Set docMail = Nothing
Set docLetters = Nothing
End Sub