Combine multiple word files into 1 document and add section breaks

[svo]

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:

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