Combine multiple word files into 1 document and add section breaks

svo · #1 08-04-2015, 12:51 AM

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
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
Macro for Combining Multiple Word Files Together Into One Document	rsrasc	Word VBA	2	10-31-2014 07:58 AM
Hidden page breaks and section breaks	jrasicmark	Word	3	06-02-2014 11:28 PM
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