Mail Merge Macro Help

[Marcus]

1 ) I have a mail merge function that constantly adds an extra page to the
resulting documents I have read eqarlier posts here and followed them but Im
still getting the extra page.

2) How do I stop the document flickering Ive added code that Ive used for
stopping flickering but it still does it the document is about 300 letters It
would be nice to make this mail merge cleaner.

3) one of the main problems is I need to send the original template to
another office so they can use it how do I get the macro from the template to
the newly created Letters document so they can split it. On my machine the
macro is there but when they follow the steps I have given them the macro is
not there on the newly created document which is then menat to be split.

The Code :-

Sub RunME()

Dim Title As String
Dim Default As String
Dim MyText As String
Dim MyName As Variant
Dim MyPath As String


Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1

Default = "Insider List"
MyText = "Enter any extra text to be included in the resulting filenames.
Long filenames may be used."
Title = "File Name"
MyName = InputBox(MyText, Title, Default)

Default = "C:\Documents and Settings\\test"
Title = "Destination Path"
MyText = "Enter a destination path e.g C:"
MyPath = InputBox(MyText, Title, Default)
If MyPath = "" Then
End
End If

' prevent any flickering
Application.ScreenUpdating = False

While Counter < Letters
With Selection

.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

End With
sName = Selection
Docname = MyPath & "\" & MyName & "." & sName & "_" & LTrim$(Str$(Counter))
& ".doc"

ActiveDocument.Sections.First.Range.Cut
Documents.Add
With Selection
.Paste
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
.Delete
End With
ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Wend

' prevent any flickering
Application.ScreenUpdating = True
End Sub


Many Thanks

 

[Doug Robbins - Word MVP]

Here is how to do it without getting the blank page at the end of each
document:

Dim i As Long, Source As Document, Target As Document, Letter As Range
Set Source = ActiveDocument
For i = 1 To Source.Sections.Count
Set Letter = Source.Sections(i).Range
Set Target = Documents.Add
Target.Range = Letter
Target.Sections(2).PageSetup.SectionStart = wdSectionContinuous
Target.SaveAs FileName:="Letter" & i
Target.Close
Next i

To make this available to your users, you should create a template in which
you create the macro and send that template to the users and have them save
it in their Word Startup folder. It will then be available to them whenever
they need it.

Also See the "Individual Merge Letters" item on fellow MVP Graham Mayor's
website at:

http://www.gmayor.com/individual_merge_letters.htm

If you are using Word XP or later, the "Add-in to Merge Letters to Separate
Files" that I have written and that can be downloaded from that site will
allow you to create each letter as a separate file with a filename taken
from a field in the data source with a minimum of fuss.





--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP