question for Doug Robbins

[Jack Sons]

Doug,

I have problems with the code below. Suzanne Barnhill thouht you are the
author. I formulated my problem below the code (it is my original mail to
Suzanne, already with an attachment). You see that is is absolutely
necessary to send you a sample of the mailmerged document that causes
execution of the code to derail. If you want to help me, please allow me to
mail my document directly to you, as I can't post in the NG with an
attachment.

Jack Sons
The Netherlands


----------------------------------------------------------------------------
------------------------

Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
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 mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
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



----------------------------------------------------------------------------
------------------------------------------------------------------

A year or two ago I got code for splitting a mail mergerd document into its
separate parts and saving these parts.
I hope I made clear what I mean. In other words: after mailmerging a new
document exists that comprises a number of documents that are identical
except for the merged data in it, for instance the name and address of the
adressees.

The code below will not work to split my standard mail merged
correspondence of which I would like to put a small example below the code,
but it is to complex, some items disappear. Therefore I have to put it in an
attachment. Have no fear opening it, all my incoming and outgoing stuff is
screened by my provider and also by my own Norton Anti Virus.

I often produce mail merged letters consisting of 20 to 50 separate
letters. I always have to extract the individual sub letters in a tedious
way, by selecting one and deleting all that is above it and all that is
below it, then saving the remaining separate letter, then calling and
opening the complete mail merged document again, selecting the next sub
document, deleting all that is above it etc. 50 times! It is awfully time
consuming.

You would be an enormous help if you could give me the code that does the
trick.

For your information, the first subdocument should be saved as "Ermakova 1
SHS.doc". It is clear where the Ermakova and the SHS come from, the 1 is the
number between the --, so it is the one of -1- Ermakova is the last word of
the first line (with text) after Aan: (Aan: could or could not be
underlined).
If automatically saving with a name in the way I indicated is to complex,
saving via a prompt (kind of box in which to fill in the complete name, so
in this case Ermakova 1 SHS.doc) that wil be fine for me, perhaps that is a
safer solution than automatically naming what is to be saved, although it
would be nice if both options where available to me so I can choose which
one to use for a particular mail merged document (if all adresses are simple
and straight forward I would do it the automatical way, otherwise via the
prompt box).

Well again, my life will be a lot easier if you could get this to work. A
thousand thanks in advance. Please don't mind my somewhat peculiar English.

 

[Jean-Guy Marcil]

Hi Jack,

Here is a slightly different approach:
Take all sections generated by the mailmerge and create documents directly
from there:
To make sure it works well, the code should be in Global template and each
new document should be created from the same template from which the main
mailmerge document was created (especially because of the headers and
footers).

'_______________________________________
Sub Sections_toDoc()

Dim CurDoc As Document
Dim TempDoc As Document
Dim DocSection As Section

Dim CurDocName As String
Dim CurDocPath As String
Dim SecCount As Long

Dim DocSectionContent As Range
Dim TempDocContent As Range

'Prepare variables
'Current document must be saved first
If ActiveDocument.Path = "" Or _
ActiveDocument.Saved = False Then
MsgBox "You must save the current document " _
& "before proceeding."
Exit Sub
End If
Set CurDoc = ActiveDocument
CurDocName = CurDoc.Name
CurDocName = Left(CurDocName, _
Len(CurDocName) - 4)
CurDocPath = CurDoc.Path
SecCount = 1

'Create documents from each section
For Each DocSection In CurDoc.Sections
Set DocSectionContent = DocSection.Range
'To remove the section break (from mailmerge)
'from the range
DocSectionContent.SetRange _
DocSectionContent.Start, _
DocSectionContent.End - 1

'Prepare TempDoc to receive section content
'Change path and name of template
'You did not mention your Word version
'It is possible that the Visible:=False may not be
'recognized, in which case just remove it, including the
'comma just before
Set TempDoc = Documents.Add _
(Template:="D:\My Template Folder\MyTemplate.dot", _
Visible:=False)
Set TempDocContent = TempDoc.Range
TempDocContent = DocSectionContent
'Save each document in the same folder as the original document
'and add a number to the end of the name
TempDoc.SaveAs CurDocPath & _
Application.PathSeparator & _
CurDocName & SecCount & ".doc"
TempDoc.Close
Set TempDoc = Nothing
SecCount = SecCount + 1

Next DocSection

End Sub
'_______________________________________

If you want people to help you with Doug's code, you have to tell us which
version of Word you are using and what exactly is the problem.

I understand you would Prefer that Doug contacted personally, but he may not
have the time right now... In any case, I believe it would be more efficient
for you if you explained the problem in a few more details (Beyond the fact
that you are experiencing problems and that it is derailing!) so that many
people can suggest solutions.

HTH
--
Cheers!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Jack Sons]

Jean-Guy,

Thanks for your answer.
I use XP and Word 2000.
What to do with:
Template:="D:\My Template Folder\MyTemplate.dot", Visible:=False)
Execution of the sub halts at this line.
What template, I have no idea. Perhaps the misterious Normal.dot? Where do I
find it? I work on C:\ only.
What goes wrong with the code I originally posted is for me difficult to
describe. If you allow me to send you a mail merged document and you use
that code you certainly will understand.

By now I found rathet simple and nicely working code in Doug's answer in the
NG word.mailmerge.fields
Subject: Re: Merging, then saving letters as individual files?
Date: Mon, 9 Feb 2004 18:21:19

but (first I let follow that code, my remarks follow below the code):
----------------------------------------------------------------------------
----------
Sub Unmerge() ' I added the first two
lines and the last two lines
Application.ScreenUpdating = False

' Macro created 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

Application.ScreenUpdating = True

End Sub
---------------------------------------------------------------------------
This works great, but the results are automatically named MyLetter1,
MyLetter2 etc. Changing that to proper names is very time consuming for,
say, 50 subdocs.
In a sample that I would like to send you (small, 3 letters) MyLetter1
should be named
"Ermakova 1 SHS CdP achterstand 060204.doc",
the "Ermakova", the "1" (this 1 is not from Doug's counter!) and the "SHS"
coming from certain points on certain lines (in fixed places) somewhere in
the top of the letter,

(this is a bit complicated, can't explain it without showing the doc, but
when I try to put it in this email the most characteristic part disappears
because it is in fact a small "table" in which address, subject etc. are
incorporated. All this will no doubt sound misty due to the fact of my
peculiar English - sorry for that, I have never the possibility to speak
English, I just read it in Time Magazine and newsgroups - and due to the
fact that I use a Dutch language version of XP and Word 2000),

the rest is added by me, "CdP achterstand 060204" will be the same for all
subdocs.
So the macro (the sub) should take the first three elements for the name of
a subdoc from the subdoc itself and the rest (achterstand 060204) from an
input box, or I would have to put it somewhere in the code, which is also a
good possibility.
Again, if I could email you my doc all would in no time be clear to you. A
pitty I am not allowed to post with attachments in a NG, what of course is
understandable.

Please help me further, I am so close already.

Jack

Hi Jack,

Here is a slightly different approach:
Take all sections generated by the mailmerge and create documents directly
from there:
To make sure it works well, the code should be in Global template and each
new document should be created from the same template from which the main
mailmerge document was created (especially because of the headers and
footers).

'_______________________________________
Sub Sections_toDoc()

Dim CurDoc As Document
Dim TempDoc As Document
Dim DocSection As Section

Dim CurDocName As String
Dim CurDocPath As String
Dim SecCount As Long

Dim DocSectionContent As Range
Dim TempDocContent As Range

'Prepare variables
'Current document must be saved first
If ActiveDocument.Path = "" Or _
ActiveDocument.Saved = False Then
MsgBox "You must save the current document " _
& "before proceeding."
Exit Sub
End If
Set CurDoc = ActiveDocument
CurDocName = CurDoc.Name
CurDocName = Left(CurDocName, _
Len(CurDocName) - 4)
CurDocPath = CurDoc.Path
SecCount = 1

'Create documents from each section
For Each DocSection In CurDoc.Sections
Set DocSectionContent = DocSection.Range
'To remove the section break (from mailmerge)
'from the range
DocSectionContent.SetRange _
DocSectionContent.Start, _
DocSectionContent.End - 1

'Prepare TempDoc to receive section content
'Change path and name of template
'You did not mention your Word version
'It is possible that the Visible:=False may not be
'recognized, in which case just remove it, including the
'comma just before
Set TempDoc = Documents.Add _
(Template:="D:\My Template Folder\MyTemplate.dot", _
Visible:=False)
Set TempDocContent = TempDoc.Range
TempDocContent = DocSectionContent
'Save each document in the same folder as the original document
'and add a number to the end of the name
TempDoc.SaveAs CurDocPath & _
Application.PathSeparator & _
CurDocName & SecCount & ".doc"
TempDoc.Close
Set TempDoc = Nothing
SecCount = SecCount + 1

Next DocSection

End Sub
'_______________________________________

If you want people to help you with Doug's code, you have to tell us which
version of Word you are using and what exactly is the problem.

I understand you would Prefer that Doug contacted personally, but he may not
have the time right now... In any case, I believe it would be more efficient
for you if you explained the problem in a few more details (Beyond the fact
that you are experiencing problems and that it is derailing!) so that many
people can suggest solutions.

HTH
--
Cheers!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

Doug,

I have problems with the code below. Suzanne Barnhill thouht you are the
author. I formulated my problem below the code (it is my original mail to
Suzanne, already with an attachment). You see that is is absolutely
necessary to send you a sample of the mailmerged document that causes
execution of the code to derail. If you want to help me, please allow me to
mail my document directly to you, as I can't post in the NG with an
attachment.

Jack Sons
The Netherlands


--------------------------------------------------------------------------
--
------------------------

Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
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 mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
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



--------------------------------------------------------------------------
--
------------------------------------------------------------------

A year or two ago I got code for splitting a mail mergerd document into its
separate parts and saving these parts.
I hope I made clear what I mean. In other words: after mailmerging a new
document exists that comprises a number of documents that are identical
except for the merged data in it, for instance the name and address of the
adressees.

The code below will not work to split my standard mail merged
correspondence of which I would like to put a small example below the code,
but it is to complex, some items disappear. Therefore I have to put it

in

an
attachment. Have no fear opening it, all my incoming and outgoing stuff is
screened by my provider and also by my own Norton Anti Virus.

I often produce mail merged letters consisting of 20 to 50 separate
letters. I always have to extract the individual sub letters in a tedious
way, by selecting one and deleting all that is above it and all that is
below it, then saving the remaining separate letter, then calling and
opening the complete mail merged document again, selecting the next sub
document, deleting all that is above it etc. 50 times! It is awfully time
consuming.

You would be an enormous help if you could give me the code that does the
trick.

For your information, the first subdocument should be saved as "Ermakova 1
SHS.doc". It is clear where the Ermakova and the SHS come from, the 1 is the
number between the --, so it is the one of -1- Ermakova is the last word of
the first line (with text) after Aan: (Aan: could or could not be
underlined).
If automatically saving with a name in the way I indicated is to complex,
saving via a prompt (kind of box in which to fill in the complete name, so
in this case Ermakova 1 SHS.doc) that wil be fine for me, perhaps that

is

 

[Jean-Guy Marcil]

Hi Jack,

Never mind my code if you found one that readily works for you.

For the document names...

The easiest I can think of right now would be to put your basic info in a
table in the main document before the merge. This way you could easily get
the information by getting the text from specified table cells and thus
building each document name.

If you can adjust the main document to create a table to contain the basic
info, let me know.

Unless some one comes up with an even easier solution that I can't see right
now!|
--
Cheers!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

Jean-Guy,

Thanks for your answer.
I use XP and Word 2000.
What to do with:
Template:="D:\My Template Folder\MyTemplate.dot", Visible:=False)
Execution of the sub halts at this line.
What template, I have no idea. Perhaps the misterious Normal.dot? Where do I
find it? I work on C:\ only.
What goes wrong with the code I originally posted is for me difficult to
describe. If you allow me to send you a mail merged document and you use
that code you certainly will understand.

By now I found rathet simple and nicely working code in Doug's answer in the
NG word.mailmerge.fields
Subject: Re: Merging, then saving letters as individual files?
Date: Mon, 9 Feb 2004 18:21:19

but (first I let follow that code, my remarks follow below the code):
-------------------------------------------------------------------------- --
----------
Sub Unmerge() ' I added the first two
lines and the last two lines
Application.ScreenUpdating = False

' Macro created 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

Application.ScreenUpdating = True

End Sub
-------------------------------------------------------------------------- -
This works great, but the results are automatically named MyLetter1,
MyLetter2 etc. Changing that to proper names is very time consuming for,
say, 50 subdocs.
In a sample that I would like to send you (small, 3 letters) MyLetter1
should be named
"Ermakova 1 SHS CdP achterstand 060204.doc",
the "Ermakova", the "1" (this 1 is not from Doug's counter!) and the "SHS"
coming from certain points on certain lines (in fixed places) somewhere in
the top of the letter,

(this is a bit complicated, can't explain it without showing the doc, but
when I try to put it in this email the most characteristic part disappears
because it is in fact a small "table" in which address, subject etc. are
incorporated. All this will no doubt sound misty due to the fact of my
peculiar English - sorry for that, I have never the possibility to speak
English, I just read it in Time Magazine and newsgroups - and due to the
fact that I use a Dutch language version of XP and Word 2000),

the rest is added by me, "CdP achterstand 060204" will be the same for all
subdocs.
So the macro (the sub) should take the first three elements for the name of
a subdoc from the subdoc itself and the rest (achterstand 060204) from an
input box, or I would have to put it somewhere in the code, which is also a
good possibility.
Again, if I could email you my doc all would in no time be clear to you. A
pitty I am not allowed to post with attachments in a NG, what of course is
understandable.

Please help me further, I am so close already.

Jack

Hi Jack,

Here is a slightly different approach:
Take all sections generated by the mailmerge and create documents directly
from there:
To make sure it works well, the code should be in Global template and each
new document should be created from the same template from which the main
mailmerge document was created (especially because of the headers and
footers).

'_______________________________________
Sub Sections_toDoc()

Dim CurDoc As Document
Dim TempDoc As Document
Dim DocSection As Section

Dim CurDocName As String
Dim CurDocPath As String
Dim SecCount As Long

Dim DocSectionContent As Range
Dim TempDocContent As Range

'Prepare variables
'Current document must be saved first
If ActiveDocument.Path = "" Or _
ActiveDocument.Saved = False Then
MsgBox "You must save the current document " _
& "before proceeding."
Exit Sub
End If
Set CurDoc = ActiveDocument
CurDocName = CurDoc.Name
CurDocName = Left(CurDocName, _
Len(CurDocName) - 4)
CurDocPath = CurDoc.Path
SecCount = 1

'Create documents from each section
For Each DocSection In CurDoc.Sections
Set DocSectionContent = DocSection.Range
'To remove the section break (from mailmerge)
'from the range
DocSectionContent.SetRange _
DocSectionContent.Start, _
DocSectionContent.End - 1

'Prepare TempDoc to receive section content
'Change path and name of template
'You did not mention your Word version
'It is possible that the Visible:=False may not be
'recognized, in which case just remove it, including the
'comma just before
Set TempDoc = Documents.Add _
(Template:="D:\My Template Folder\MyTemplate.dot", _
Visible:=False)
Set TempDocContent = TempDoc.Range
TempDocContent = DocSectionContent
'Save each document in the same folder as the original document
'and add a number to the end of the name
TempDoc.SaveAs CurDocPath & _
Application.PathSeparator & _
CurDocName & SecCount & ".doc"
TempDoc.Close
Set TempDoc = Nothing
SecCount = SecCount + 1

Next DocSection

End Sub
'_______________________________________

If you want people to help you with Doug's code, you have to tell us which
version of Word you are using and what exactly is the problem.

I understand you would Prefer that Doug contacted personally, but he may not
have the time right now... In any case, I believe it would be more efficient
for you if you explained the problem in a few more details (Beyond the fact
that you are experiencing problems and that it is derailing!) so that many
people can suggest solutions.

HTH
--
Cheers!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

Doug,

I have problems with the code below. Suzanne Barnhill thouht you are the
author. I formulated my problem below the code (it is my original mail to
Suzanne, already with an attachment). You see that is is absolutely
necessary to send you a sample of the mailmerged document that causes
execution of the code to derail. If you want to help me, please allow

me
to

mail my document directly to you, as I can't post in the NG with an
attachment.

Jack Sons
The Netherlands

--------------------------------------------------------------------------

--
------------------------

Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
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 mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
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

-------------------------------------------------------------------------- into
its

separate parts and saving these parts.
I hope I made clear what I mean. In other words: after mailmerging a new
document exists that comprises a number of documents that are identical
except for the merged data in it, for instance the name and address of the
adressees.

The code below will not work to split my standard mail merged
correspondence of which I would like to put a small example below the code,
but it is to complex, some items disappear. Therefore I have to put it

in

an
attachment. Have no fear opening it, all my incoming and outgoing

stuff

is

"Ermakova

1 is
the word
of

name,

so is

work.

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Hi Jack,

Here's a method that I have used that involves creating a separate
catalog type mailmerge maindocument which creates a word document containing
a table in each row of which would be your data from the database that you
want to use as the filename.

You first execute that mailmerge, then save that file and close it. Then
execute the mailmerge that you want to create the separate files from and
with the
result of that on the screen, run a macro containing the following code
and when the File open dialog appears, select the file containing the table
created by the first mailmerge

Dim Source As Document, oblist As Document, DocName As Range, DocumentName
As String
Set Source = ActiveDocument
With Dialogs(wdDialogFileOpen)
.Show
End With
Set oblist = ActiveDocument
Counter = 1
While Counter < oblist.Tables(1).Rows.Count
Set DocName = oblist.Tables(1).Cell(Counter, 1).Range
DocName.End = DocName.End - 1

'Change the path in the following command to suit where you want to save
the documents.
DocumentName = "I:\WorkArea\Documentum\" & DocName.Text
Source.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.SaveAs filename:=DocumentName, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Counter = Counter + 1
Wend


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

Jean-Guy,

Thanks for your answer.
I use XP and Word 2000.
What to do with:
Template:="D:\My Template Folder\MyTemplate.dot", Visible:=False)
Execution of the sub halts at this line.
What template, I have no idea. Perhaps the misterious Normal.dot? Where do
I
find it? I work on C:\ only.
What goes wrong with the code I originally posted is for me difficult to
describe. If you allow me to send you a mail merged document and you use
that code you certainly will understand.

By now I found rathet simple and nicely working code in Doug's answer in
the
NG word.mailmerge.fields
Subject: Re: Merging, then saving letters as individual files?
Date: Mon, 9 Feb 2004 18:21:19

but (first I let follow that code, my remarks follow below the code):
----------------------------------------------------------------------------
----------
Sub Unmerge() ' I added the first two
lines and the last two lines
Application.ScreenUpdating = False

' Macro created 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

Application.ScreenUpdating = True

End Sub
---------------------------------------------------------------------------
This works great, but the results are automatically named MyLetter1,
MyLetter2 etc. Changing that to proper names is very time consuming for,
say, 50 subdocs.
In a sample that I would like to send you (small, 3 letters) MyLetter1
should be named
"Ermakova 1 SHS CdP achterstand 060204.doc",
the "Ermakova", the "1" (this 1 is not from Doug's counter!) and the "SHS"
coming from certain points on certain lines (in fixed places) somewhere in
the top of the letter,

(this is a bit complicated, can't explain it without showing the doc, but
when I try to put it in this email the most characteristic part disappears
because it is in fact a small "table" in which address, subject etc. are
incorporated. All this will no doubt sound misty due to the fact of my
peculiar English - sorry for that, I have never the possibility to speak
English, I just read it in Time Magazine and newsgroups - and due to the
fact that I use a Dutch language version of XP and Word 2000),

the rest is added by me, "CdP achterstand 060204" will be the same for all
subdocs.
So the macro (the sub) should take the first three elements for the name
of
a subdoc from the subdoc itself and the rest (achterstand 060204) from an
input box, or I would have to put it somewhere in the code, which is also
a
good possibility.
Again, if I could email you my doc all would in no time be clear to you. A
pitty I am not allowed to post with attachments in a NG, what of course is
understandable.

Please help me further, I am so close already.

Jack

 

[Jack Sons]

Doug and Jean-Guy, thank you both.

Jack.

Doug,

I have problems with the code below. Suzanne Barnhill thouht you are the
author. I formulated my problem below the code (it is my original mail to
Suzanne, already with an attachment). You see that is is absolutely
necessary to send you a sample of the mailmerged document that causes
execution of the code to derail. If you want to help me, please allow me to
mail my document directly to you, as I can't post in the NG with an
attachment.

Jack Sons
The Netherlands


-------------------------------------------------------------------------- --
------------------------

Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
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 mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
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



-------------------------------------------------------------------------- --
------------------------------------------------------------------

A year or two ago I got code for splitting a mail mergerd document into its
separate parts and saving these parts.
I hope I made clear what I mean. In other words: after mailmerging a new
document exists that comprises a number of documents that are identical
except for the merged data in it, for instance the name and address of the
adressees.

The code below will not work to split my standard mail merged
correspondence of which I would like to put a small example below the code,
but it is to complex, some items disappear. Therefore I have to put it in an
attachment. Have no fear opening it, all my incoming and outgoing stuff is
screened by my provider and also by my own Norton Anti Virus.

I often produce mail merged letters consisting of 20 to 50 separate
letters. I always have to extract the individual sub letters in a tedious
way, by selecting one and deleting all that is above it and all that is
below it, then saving the remaining separate letter, then calling and
opening the complete mail merged document again, selecting the next sub
document, deleting all that is above it etc. 50 times! It is awfully time
consuming.

You would be an enormous help if you could give me the code that does the
trick.

For your information, the first subdocument should be saved as "Ermakova 1
SHS.doc". It is clear where the Ermakova and the SHS come from, the 1 is the
number between the --, so it is the one of -1- Ermakova is the last word of
the first line (with text) after Aan: (Aan: could or could not be
underlined).
If automatically saving with a name in the way I indicated is to complex,
saving via a prompt (kind of box in which to fill in the complete name, so
in this case Ermakova 1 SHS.doc) that wil be fine for me, perhaps that is a
safer solution than automatically naming what is to be saved, although it
would be nice if both options where available to me so I can choose which
one to use for a particular mail merged document (if all adresses are simple
and straight forward I would do it the automatical way, otherwise via the
prompt box).

Well again, my life will be a lot easier if you could get this to work. A
thousand thanks in advance. Please don't mind my somewhat peculiar English.
--