Can anyone help with this mail merge?

[Debbie]

I've never written VBA code of my own (only changed things
I've recorded). I recorded a macro to do a mail merge but
I need the macro to save my records to multiple files for
each Company. I tried using a MailMergeBeforeRecordMerge
Event to change the name of the output file but I keep
getting an error that I need an "End Sub". I just do't
see the error.

Sub TestMerge()
Dim hld_agcy As String
Set DocName = "I:\Groups\Shared\letters\elg\Agency Vesting
Letters\Merged Files\vstltr_" & agency_hld & "_" & Date


ChangeFileOpenDirectory "I:\groups\shared\letters\elg\Agenc
y Vesting Letters"
Documents.Open FileName:="Master FullVesting
Letter.doc", ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", Revert:=False,
WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto

ActiveDocument.MailMerge.OpenDataSource Name:= _
"J:\access\WordMerge\Letters.mdb",
ConfirmConversions:=False, ReadOnly:= _
False, LinkToSource:=True,
AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="",
WritePasswordTemplate:= _
"", Revert:=False, Format:=wdOpenFormatAuto,
Connection:= _
"QUERY RetVstAgcySrt", SQLStatement:="SELECT *
FROM [RetVstAgcySrt]", _
SQLStatement1:="", SubType:=wdMergeSubTypeOther

With ActiveDocument.MailMerge
.Destination = DocName
.SuppressBlankLines = True
With .DataSource
Private Sub
MailMergeApp_MailMergeBeforeRecordMerge(ByVal
ActiveDocument As Document)
If mem_agcy <> hld_agcy _
Then hld_agcy = mem_agcy
End If
End Sub
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With

ChangeFileOpenDirectory _
"I:\Groups\Shared\letters\elg\Agency Vesting
Letters\"

ActiveDocument.SaveAs FileName:=DocName, _
FileFormat:=wdFormatDocument, LockComments:=False,
Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False,
SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False

End Sub

 

[Debbie]

Doug,

I've seen this code several times but it doesn't really do
what I need. I need a collection of letters for a
particular agency# saved as one document rather than
splitting them all out into seperate documents. An agency
can have 1 letter or 1,000 letters but as long as the
agency# is the same the letters should go to a file with
the agency# in the file name. Each of those files will
then be converted to PDF's and put on the agency's web
site.

A friend of mine helped me with some code similar to this
a while back but it was just a report instead of a letter
and we accomplished it by creating 1 table with unique
agency numbers and another table with the report
information and looping through until the agency#
changed.

If you can think of anything else your help would be much
appreciated.

-----Original Message-----
Hi Debbie,

If you execute the merge and then use the following macro on the document
that is produced by the merge, it will save the document that is created for
each record as a separate file.


Sub splitter()

'

' splitter Macro

' Macro created 16-08-98 by Doug Robbins to save each letter created by a
mailmerge as a separate file.

Dim Letters As Integer, Counter As Integer
Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
DocName = "Myletter" & LTrim$(Str$(Counter))
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
ActiveDocument.SaveAs FileName:=DocName, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Counter = Counter + 1
Wend

End Sub

Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

I've never written VBA code of my own (only changed things
I've recorded). I recorded a macro to do a mail merge but
I need the macro to save my records to multiple files for
each Company. I tried using a MailMergeBeforeRecordMerge
Event to change the name of the output file but I keep
getting an error that I need an "End Sub". I just do't
see the error.

Sub TestMerge()
Dim hld_agcy As String
Set DocName = "I:\Groups\Shared\letters\elg\Agency Vesting
Letters\Merged Files\vstltr_" & agency_hld & "_" & Date


ChangeFileOpenDirectory "I:\groups\shared\letters\elg\Agenc
y Vesting Letters"
Documents.Open FileName:="Master FullVesting
Letter.doc", ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", Revert:=False,
WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto

ActiveDocument.MailMerge.OpenDataSource Name:= _
"J:\access\WordMerge\Letters.mdb",
ConfirmConversions:=False, ReadOnly:= _
False, LinkToSource:=True,
AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="",
WritePasswordTemplate:= _
"", Revert:=False, Format:=wdOpenFormatAuto,
Connection:= _
"QUERY RetVstAgcySrt", SQLStatement:="SELECT *
FROM [RetVstAgcySrt]", _
SQLStatement1:="", SubType:=wdMergeSubTypeOther

With ActiveDocument.MailMerge
.Destination = DocName
.SuppressBlankLines = True
With .DataSource
Private Sub
MailMergeApp_MailMergeBeforeRecordMerge(ByVal
ActiveDocument As Document)
If mem_agcy <> hld_agcy _
Then hld_agcy = mem_agcy
End If
End Sub
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With

ChangeFileOpenDirectory _
"I:\Groups\Shared\letters\elg\Agency Vesting
Letters\"

ActiveDocument.SaveAs FileName:=DocName, _
FileFormat:=wdFormatDocument, LockComments:=False,
Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False,
SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False

End Sub

.

 

[Cindy Meister -WordMVP-]

Hi Debbie,

I tried using a MailMergeBeforeRecordMerge
Event to change the name of the output file but I keep
getting an error that I need an "End Sub". I just do't
see the error.

Here's one problem:

Set DocName = "I:\Groups\Shared\letters\elg\Agency Vesting
Letters\Merged Files\vstltr_" & agency_hld & "_" & Date

DocName should
1) be defined at the beginning of your code
2) probably as a string (pure text): Dim DocName as String
3) And when a variable is just to contain information, and
not an object, you shouldn't put SET in front of it

So...

Sub TestMerge()
Dim hld_agcy As String
Dim DocName as String
DocName = "I:\Groups\Shared\letters\elg\Agency Vesting
Letters\Merged Files\vstltr_" & agency_hld & "_" & Date

Then, probably the problem that's causing the error message
(which is why the above has never been flagged, yet) is
below. You can't put "Private Sub" with some other stuff,
then an "End Sub" in the middle of any other Sub. Try
deleting those two lines and see if that gets you any
further.

With .DataSource
Private Sub
MailMergeApp_MailMergeBeforeRecordMerge(ByVal
ActiveDocument As Document)
If mem_agcy <> hld_agcy _
Then hld_agcy = mem_agcy
End If
End Sub

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update
Jan 24 2003)
http://www.mvps.org/word

This reply is posted in the Newsgroup; please post any
follow question or reply in the newsgroup and not by e-mail