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