Hi,

I have created a MailMerge that seperates all of the documents and saves
them seperately using the following in Visual Basic - does anyone know how I
could use a field from within the MailMerge itself as well as the current
date? The area where the Filename is set is:-
.SaveAs FileName:="Save Merge" & CStr(docCounter) & _
    Format(Now(), "dd_mm_yyyy"),

Thanks.

Sub Seperate()
  Dim MainDoc As Word.Document
  Dim fld As Word.Field
 
  Set MainDoc = ActiveDocument
 
  With MainDoc
   .MailMerge.Destination = wdSendToNewDocument
   .MailMerge.Execute
  End With
 
  Dim ResultDoc As Word.Document
  Set ResultDoc = ActiveDocument
 
  ' Save each record's form letter as a separate document.
 SaveRecsAsFiles ResultDoc
End Sub
 
Sub SaveRecsAsFiles(doc As Word.Document)
  ' Convert all sections to Subdocs.
 AllSectionsToSubDoc doc
  ' Save each Subdoc as a separate file.
 SaveAllSubDocs doc
End Sub
 
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 _
     doc.Sections(secCounter).Range
  Next secCounter
 
End Sub
 
Sub SaveAllSubDocs(ByRef doc As Word.Document)
  Dim subdoc As Word.Subdocument
  Dim newdoc As Word.Document
  Dim docCounter As Long
 
 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
    ' Remove NextPage section breaks originating
   ' from mail merge.
   RemoveAllSectionBreaks newdoc
    With newdoc
     .SaveAs FileName:="Save Merge" & CStr(docCounter) & _
    Format(Now(), "dd_mm_yyyy")
     .Close
    End With
   docCounter = docCounter + 1
 
    ' Word 97 may require:
   ' Set newdoc = Nothing.
 Next
End Sub
 
Sub RemoveAllSectionBreaks(doc As Word.Document)
  With doc.Range.Find
   .ClearFormatting
   .Text = "^b"
    With .Replacement
     .ClearFormatting
     .Text = ""
    End With
   .Execute Replace:=wdReplaceAll
  End With

End Sub