Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 08-04-2015, 12:51 AM
svo svo is offline Combine multiple word files into 1 document and add section breaks Windows 7 64bit Combine multiple word files into 1 document and add section breaks Office 2003
Novice
Combine multiple word files into 1 document and add section breaks
 
Join Date: Jun 2015
Posts: 7
svo is on a distinguished road
Default Combine multiple word files into 1 document and add section breaks

Hello guys!



I need an idea how to make my process a bit better. I have a macro that combines files within a folder to a base document and inserts section breaks after each one so i can restart page numbering. This works for about 10 documents (with 10 to 15 pages) but hangs up if there a more files in the directory. Usually it will be like 300 documents in there (which will result in a master file with approx 3.2k pages)

The Problem seems to be that after every paste, words built-in renumbering takes place. And because the document gets longer and longer, there will be a moment when it locks up.

the documents I combine are linearized (only consist of 1 section), so that page numbers will reset after every new pasted document in the master document.

Maybe there is a page limit for word? Would it work better with word 2010? The process works nicely at a small scale but can not cope with the production scale.

Here is my Code:
Code:
Sub CombineAll(sPath As String)
    Dim baseDoc As Document, sFile As String
    Set baseDoc = Application.Documents.Add

    sFile = Dir(sPath & "*.doc")

    'Loop through all .doc files in that path
    Do While sFile <> ""

       Set sourceDoc = Application.Documents.Open(sPath & sFile)
       Application.Selection.WholeStory
       Application.Selection.Copy
       Application.ActiveWindow.Close savechanges:=wdDoNotSaveChanges
       baseDoc.Activate

       Application.Selection.PasteAndFormat (wdFormatOriginalFormatting)
       Selection.InsertBreak Type:=wdSectionBreakNextPage

       sFile = Dir
    Loop
End Sub


Sub RebuildNumbering()
    ' Renumber pages
    Dim sc As Integer: sc = ActiveDocument.Sections.Count
    For S = 1 To sc
        Selection.GoTo What:=wdGoToSection, Count:=S

        'Unlink sections from each other
 ActiveDocument.Sections(S).Footers(wdHeaderFooterFirstPage).LinkToPrevious = False
        With ActiveDocument.Sections(S).Footers(wdHeaderFooterFirstPage)
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.NumberStyle = wdPageNumberStyleArabic
            .PageNumbers.StartingNumber = 1
        End With
    Next S
End Sub
Reply With Quote
  #2  
Old 08-04-2015, 01:42 AM
gmayor's Avatar
gmayor gmayor is offline Combine multiple word files into 1 document and add section breaks Windows 7 64bit Combine multiple word files into 1 document and add section breaks Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Rather than copy and paste which is slow and gobbles memory, use InsertFile e.g. as follows. The DoEvents command should prevent it appearing to hang.
Note that combining documents works best when all are based on the same template (including and especially the basedoc).

Code:
Sub CombineAll(sPath As String)
Dim baseDoc As Document, sFile As String
Dim oRng As Range
    On Error GoTo err_Handler
    Set baseDoc = Application.Documents.Add
    sFile = Dir(sPath & "*.doc")
    'Loop through all .doc files in that path
    Do While sFile <> ""
        Set oRng = baseDoc.Range
        oRng.Collapse wdCollapseEnd
        oRng.InsertFile sPath & sFile
        Set oRng = baseDoc.Range
        oRng.Collapse wdCollapseEnd
        oRng.InsertBreak Type:=wdSectionBreakNextPage
        sFile = Dir
        DoEvents
    Loop
    MsgBox "Process complete"
lbl_Exit:
    Set baseDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub
A document of 3000+ pages will be slow to process, but is well within Word's capabilities. Hopefully the documents do not contain illustrations as this will make the document even more ponderous.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 08-04-2015, 01:46 AM
svo svo is offline Combine multiple word files into 1 document and add section breaks Windows 7 64bit Combine multiple word files into 1 document and add section breaks Office 2003
Novice
Combine multiple word files into 1 document and add section breaks
 
Join Date: Jun 2015
Posts: 7
svo is on a distinguished road
Default

Hi Graham!

I will try it on word 2010 and Word 2003. I just tested it with fewer documents and in Word 2010 I combined and renumbered 100 documents with about 800 pages in the master document.

Thanks for your reply. Will report back in a few.
Reply With Quote
  #4  
Old 08-05-2015, 03:05 AM
svo svo is offline Combine multiple word files into 1 document and add section breaks Windows 7 64bit Combine multiple word files into 1 document and add section breaks Office 2003
Novice
Combine multiple word files into 1 document and add section breaks
 
Join Date: Jun 2015
Posts: 7
svo is on a distinguished road
Default

Hi again Graham!

I implemented the Code you provided and had a couple of adjustments made to it. Word still will lock up after a number of combined documents. In 2003 this will happen earlier then in 2010. So I got around that by splitting my combined documents up into chunks, which can be set in the control document.

The code you provided speed up the whole combining by a factor of atleast 10 times. So a big thanks to this solution.

Code:
Sub CombineAll(sPath As String)
    Dim baseDoc As Document, sFile As String
    Dim oRng As Range
    ' Read the Size of the Splitter from the Bookmark in the control document
    Dim Splitter As Integer
    If ActiveDocument.Bookmarks.Exists("Splitter") Then
        On Error GoTo NoSplitter
        Splitter = Int(ActiveDocument.Bookmarks("Splitter").Range.Text)
    End If
    
    On Error GoTo err_Handler
    Set baseDoc = Application.Documents.Add
    sFile = Dir(sPath & "*.doc")
    ' Loop through the .doc in the output directory
    Dim DocSet As Integer: DocSet = 1
    Do While sFile <> ""
        ' Go to the end of the master document
        Set oRng = baseDoc.Range
        oRng.Collapse wdCollapseEnd
        ' add document set
        oRng.InsertFile sPath & sFile
        Set oRng = baseDoc.Range
        oRng.Collapse wdCollapseEnd
        ' insert section break at end of master document
        oRng.InsertBreak Type:=wdSectionBreakNextPage
        ' next file
        sFile = Dir
        DoEvents
        ' splitm up and re-number pages
        If DocSet > 1 And DocSet Mod Splitter = 0 Then
            RebuildNumbering
            ActiveDocument.SaveAs (sPath & DocSet & "_Teildokument.doc")
            ' open a new document when splitted 
            Set baseDoc = Application.Documents.Add
        End If
        DocSet = DocSet + 1
    Loop
    
lbl_Exit:
    ' Re-number the last document
    RebuildNumbering
    Debug.Print "Stitching Process complete"
    Set baseDoc = Nothing
    Set oRng = Nothing
    MsgBox "Fertig"
    Exit Sub
NoSplitter:
    MsgBox "Aufsplittungswert in Steuerdokument nicht gesetzt (1 < Wert < 51 && Lesezeichen auf Wert)"
    Set baseDoc = Nothing
    Set oRang = Nothing
    End
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
End Sub

Sub RebuildNumbering()
    ' re-number pages
    Dim sc As Integer: sc = ActiveDocument.Sections.Count
    For S = 1 To sc
        ' process= unlink from previous section, reset page numbers neustarten am Sektionsbeginn
        ActiveDocument.Sections(S).Footers(wdHeaderFooterFirstPage).LinkToPrevious = False
        With ActiveDocument.Sections(S).Footers(wdHeaderFooterFirstPage)
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.NumberStyle = wdPageNumberStyleArabic
            .PageNumbers.StartingNumber = 1
        End With
    Next S
    Debug.Print "Renumbering Done"
End Sub
I also now use the InsertFile now on the sub workflow for inserting mailmerge documents in my document set.

Thanks for sharing and helping me out. Me and my clients are really happy with the result
Reply With Quote
Reply

Tags
combine documents, page numbering

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Combine multiple word files into 1 document and add section breaks Use multiple style sets in the same Word document (depending on which section the style is in) Ricyteach Word VBA 6 03-09-2015 07:11 PM
Combine multiple word files into 1 document and add section breaks Macro for Combining Multiple Word Files Together Into One Document rsrasc Word VBA 2 10-31-2014 07:58 AM
Combine multiple word files into 1 document and add section breaks Hidden page breaks and section breaks jrasicmark Word 3 06-02-2014 11:28 PM
Combine multiple word files into 1 document and add section breaks Insert section breaks in a protected document MS help Word 2 03-09-2014 05:27 PM
Deleted Section Breaks Changes Page Breaks Brantnshellie Word 0 02-01-2009 09:22 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 06:11 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft