Save documents with the data from mail merge - vba

Question

For my work I make product specifications. I have a table with all the data, and a standard Word document where the data needs to be inserted. I do this using the built-in mail merge function from Word. However, I need to save the documents seperately, and I found the following code for this:
Sub BreakOnSection()
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "C:\"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
ActiveDocument.Close
' Move the selection to the next section in the document
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
This saves the documents as test 1, test 2, etc.
I want to save the documents using one of the data items I use for the mail merge. Is there any way to do this?

Answer 1

I made it work, this is the code I have now
Sub BreakOnSection()
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mailmerge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
Dim rngParagraphs As Range
Set rngParagraphs = ActiveDocument.Range(Start:=(ActiveDocument.Paragraphs(1).Range.Start + 6), End:=(ActiveDocument.Paragraphs(1).Range.End - 1))
rngParagraphs.Select
' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "C:\"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="Productspec" & rngParagraphs & ".doc"
ActiveDocument.Close
' Move the selection to the next section in the document
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub