Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

New Documents From Mail Merge

Posted on 2005-05-10
3
Medium Priority
?
313 Views
Last Modified: 2012-05-05
I've run a mail merge and have 8,000 single page documents seperated by a "Section Break"  When I use the code below to save them as individual files I get the "Section Break" on all 8000 documents which adds a second page to the document.  

I need to know how to make it so I have 8000 single page documents and not 8000 2 page docs.

Thanks.
 
Sub AllSectionsToSubDoc()
     
    Dim x               As Long
    Dim Sections        As Long
    Dim Doc             As Document
    Dim FileName        As String
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    Set Doc = ActiveDocument
    Sections = Doc.Sections.Count
    For x = Sections - 1 To 1 Step -1
        Doc.Sections(x).Range.Copy
       
        FileName = Right$("00000000" + x, 8)
       
        Documents.Add
        ActiveDocument.Range.Paste
        ActiveDocument.SaveAs ("D:\WorkInProgress\BOW\WordMod_2\Output\" & FileName & ".doc")
        ActiveDocument.Close False
    Next x
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub
0
Comment
Question by:Whah
3 Comments
 
LVL 37

Expert Comment

by:Joanne M. Orzech
ID: 13972695
Remove the section break from the primary merge document if you have one.

Reduce the margins or the font size.

When you merge, the information merged may push the document to two pages.  You need to consider this - perhaps if you do a merge preview it will show you if the document is pushed to two pages.
0
 

Author Comment

by:Whah
ID: 13972874
If I remove the section break the split and save doesn't work.  

The merge doesn't create two pages but the split is there.  When I run the code to create the individual documents the break is still there and that creates the second page.
0
 
LVL 77

Accepted Solution

by:
GrahamSkan earned 1500 total points
ID: 13975568
Just use an intermediate Range Object and reduce its length by one character.

Sub AllSectionsToSubDoc()
     
    Dim x               As Long
    Dim Sections        As Long
    Dim Doc             As Document
    Dim FileName        As String
    Dim rng             As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    Set Doc = ActiveDocument
    Sections = Doc.Sections.Count
    For x = Sections - 1 To 1 Step -1
        Set rng = Doc.Sections(x).Range
        rng.MoveEnd wdCharacter, -1
        rng.Copy
       
        FileName = Right$("00000000" + x, 8)
       
        Documents.Add
        ActiveDocument.Range.Paste
        ActiveDocument.SaveAs ("D:\WorkInProgress\BOW\WordMod_2\Output\" & FileName & ".doc")
        ActiveDocument.Close False
    Next x
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub
0

Featured Post

Become an Android App Developer

Ready to kick start your career in 2018? Learn how to build an Android app in January’s Course of the Month and open the door to new opportunities.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you work with Word a lot, you probably use styles. If you use styles a lot, you've probably balled your fist more often than not when working with the ribbon. In Word 2007/2010, one of the things that I find missing when using styles is a quic…
I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
This video shows and describes the main difference between both orientations in Microsoft Word. Viewers will understand when to use each orientation and how to get the most out of them.
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …
Suggested Courses
Course of the Month13 days, 9 hours left to enroll

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question