#1
|
|||
|
|||
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 |
#2
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
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. |
#4
|
|||
|
|||
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 Thanks for sharing and helping me out. Me and my clients are really happy with the result |
Tags |
combine documents, page numbering |
|
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 |