Generate Filename from MailMerge

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 requi
' 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

See http://www.gmayor.com/individual_merge_letters.htm and in particular the
add in you can download from there.

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org


Adam Foot wrote:
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 requi
' 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