Hi Graham
I did all the above changes and tried to run the macro, but the result is the same the old one.
Regards,
JD
Hi Graham
I did all the above changes and tried to run the macro, but the result is the same the old one.
Regards,
JD
The code works awesomely. But the docs are not laid out exactly as the originals in the new file.
Is there something I can insert into the code to retain each document's format when it's being compiled?
No - that's as good as it gets. Combining disparate document formats will always be a compromise.
Graham Mayor - MS MVP (Word) 2002-2019
Visit my web site for more programming tips and ready made processes
http://www.gmayor.com
Hello everyone,
i am using the code from gmayor to merge multiple documents into a single document.
It is doing what it is supposed to do, but i am having a specific problem with the merged document.Sub MergeDocs() Dim rng As Range Dim MainDoc As Document Dim strFile As String, strFolder As String Dim Count As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Pick folder" .AllowMultiSelect = False If .Show Then strFolder = .SelectedItems(1) & Application.PathSeparator Else Exit Sub End If End With Set MainDoc = Documents.Add strFile = Dir$(strFolder & "*.doc") ' can change to .docx Count = 0 Do Until strFile = "" Count = Count + 1 Set rng = MainDoc.Range With rng .Collapse 0 If Count > 1 Then .InsertBreak 2 .End = MainDoc.Range.End .Collapse 0 End If .InsertFile strFolder & strFile End With strFile = Dir$() Loop MsgBox ("Files are merged") lbl_Exit: Exit Sub End Sub
The formating of the original documents isn't translated into the new document that gets created by the macro.
Normaly the original document is one page in size. In the new document, a part of the bottom is put onto a second page.
i think it has something to do with margins.
Is there a way to keep the page layout/margins from the original document and transfer that to the new document ?
greetings
Manuel
The code in question creates the base document using the normal templateYou would need to use the first document as a template to ensure you have its margins - e.g. as follows. Better still use http://www.gmayor.com/Boiler.htmSet MainDoc = Documents.Add
Sub MergeDocs() Dim rng As Range Dim MainDoc As Document Dim strFile As String, strFolder As String Dim Count As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Pick folder" .AllowMultiSelect = False If .Show Then strFolder = .SelectedItems(1) & Application.PathSeparator Else Exit Sub End If End With Count = 0 strFile = Dir$(strFolder & "*.doc") ' can change to .docx Do Until strFile = "" If Count = 0 Then Set MainDoc = Documents.Add(Template:=strFolder & strFile) Count = Count + 1 Else Set rng = MainDoc.Range With rng .Collapse 0 If Count > 1 Then .InsertBreak 2 .End = MainDoc.Range.End .Collapse 0 End If .InsertFile strFolder & strFile End With End If strFile = Dir$() Loop MsgBox ("Files are merged") lbl_Exit: Exit Sub End Sub
Graham Mayor - MS MVP (Word) 2002-2019
Visit my web site for more programming tips and ready made processes
http://www.gmayor.com
Thanks for the reply,
when i execute the code above, i get a runtime error "4605" and ".InsertFile strFolder & strFile" gets marked.
I also tried to use your ´recomended Boiler Add-In but it seems that it only recognizes normal documents.
The documents that i need to merge are mostly docm files with macros.
Is there any chance that it still works with macro enabled documents?
Hmmm. The only thing I can think of is a problem relating to the macros you say are in the document(s). The following should address (and has been tested in Word 2010 and 2016) that:
The latest version 3.4 of the Boiler add-in does work with DOCM files. When using the add-in, start with the file on screen that has the format you wish to merge into. The macros in the inserted documents will not run.Option Explicit Sub MergeDocs() Dim rng As Range Dim MainDoc As Document Dim strFile As String, strFolder As String Dim Count As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Pick folder" .AllowMultiSelect = False If .Show Then strFolder = .SelectedItems(1) & Application.PathSeparator Else Exit Sub End If End With Count = 0 strFile = Dir$(strFolder & "*.doc") ' can change to .docx Do Until strFile = "" WordBasic.DisableAutoMacros 1 If Count = 0 Then Set MainDoc = Documents.Add(Template:=strFolder & strFile) Count = Count + 1 Else Set rng = MainDoc.Range With rng .Collapse 0 If Count > 1 Then .InsertBreak 2 .End = MainDoc.Range.End .Collapse 0 End If .InsertFile strFolder & strFile End With End If strFile = Dir$() WordBasic.DisableAutoMacros 0 Loop MsgBox ("Files are merged") lbl_Exit: Exit Sub End Sub
Graham Mayor - MS MVP (Word) 2002-2019
Visit my web site for more programming tips and ready made processes
http://www.gmayor.com
Hi there,
i tried your modified code but it gives me an error saying that the documents are protected.
I thought this code would work somewhat like the build in 'text from file' comand in the 'object menu' on the 'insert tab', where it is not necessary to remove the doccuments protection.
I was looking for a more automated approach because this comand is only capable of merging a couple of documents at a time. I think the limit is 25 docs.
When you need to merge 300+ Documents it becomes very tedious for the user.
Is there a way to work around that problem, making the code usable without removing the protection of each document?
Regarding the Boiler Add-In:
When i use the Boiler Add-In, in the file selection window, only 'docx' documents are recognized.
The 'docm' files won't show up. I have version 3.4 installed.
Any clues why these files aren't recognized by the add-in?
I am sorry to take so much of your time. I hoped that it would be less complicated.
Version 3.4 of Boiler certainly lists docm format files
2016-09-21_20-07-04.jpg
The documents are protected? Protected how?
Graham Mayor - MS MVP (Word) 2002-2019
Visit my web site for more programming tips and ready made processes
http://www.gmayor.com
Ok, i deinstalled the boiler Add-In and reinstalled it.
It seems that there previously was a version 3.3 installed.
Now the Add-In lists all the documents, but it is running into the same problem as the other code.
Run-time error '4605':
This method or property is not available because the object refers to a protected area of the document.
All docm files are protected with restricted editing. so that it is only allowed to fill in forms.
Using the build in 'text from file' command is not having any problems with this restriction.
[/QUOTE]Sub MergeDocs() Dim rng As Range Dim MainDoc As Document Dim strFile As String, strFolder As String Dim Count As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Pick folder" .AllowMultiSelect = False If .Show Then strFolder = .SelectedItems(1) & Application.PathSeparator Else Exit Sub End If End With Count = 0 strFile = Dir$(strFolder & "*.doc") ' can change to .docx Do Until strFile = "" If Count = 0 Then Set MainDoc = Documents.Add(Template:=strFolder & strFile) Count = Count + 1 Else Set rng = MainDoc.Range With rng .Collapse 0 If Count > 1 Then .InsertBreak 2 .End = MainDoc.Range.End .Collapse 0 End If .InsertFile strFolder & strFile End With End If strFile = Dir$() Loop MsgBox ("Files are merged") lbl_Exit: Exit Sub End Sub
this code perfectly retains the source format but again the line break doesn't work, ending up in combining the new document in previous document; tried replacing the .InsertBreak wdSectionBreakNextPage but it really dint make any change. Will appreciate your help.
Minor change. Works for me
Option Explicit Sub MergeDocs() Dim rng As Range Dim MainDoc As Document Dim strFile As String, strFolder As String Dim Count As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Pick folder" .AllowMultiSelect = False If .Show Then strFolder = .SelectedItems(1) & Application.PathSeparator Else Exit Sub End If End With Count = 0 strFile = Dir$(strFolder & "*.doc") ' can change to .docx Do Until strFile = "" WordBasic.DisableAutoMacros 1 If Count = 0 Then Set MainDoc = Documents.Add(Template:=strFolder & strFile) Count = Count + 1 Else Set rng = MainDoc.Range With rng .Collapse 0 If Count > 0 Then .InsertBreak Type:=wdSectionBreakNextPage .End = MainDoc.Range.End .Collapse 0 End If .InsertFile strFolder & strFile End With End If strFile = Dir$() WordBasic.DisableAutoMacros 0 Loop MsgBox ("Files are merged") lbl_Exit: Exit Sub End Sub
Merging multiple documents is often rather more complex than simply copying & pasting content from one document to another. Problems arise when the documents have different page layouts, headers, footers, page numbering, bookmarks & cross-references, Tables of Contents, Indexes, etc., etc., and especially when those documents have used the same Style names with different definitions. The compromises can be mitigated, though.
The following macro handles the more common issues that arise when merging documents; it does not attempt to resolve page numbering, Tables of Contents or Indexes. Neither does it attempt to deal with the effects on footnote or endnote numbering & positioning or with the consequences of duplicated bookmarks (only one of which can exist in the merged document) and any corresponding cross-references.
The macro includes a folder browser. Simply select the folder to process and all documents from that folder will be merged into the active document.
Sub MergeDocuments() Application.ScreenUpdating = False Application.DisplayAlerts = wdAlertsNone Dim strFolder As String, strFile As String Dim DocSrc As Document, DocTgt As Document Dim strDocNm As String, Rng As Range, HdFt As HeaderFooter strFolder = GetFolder If strFolder = "" Then Exit Sub Set DocTgt = ActiveDocument strDocNm = DocTgt.FullName strFile = Dir(strFolder & "\*.doc") While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then Set DocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With DocTgt Set Rng = .Range.Characters.Last With Rng .Collapse wdCollapseEnd .InsertBreak Type:=wdSectionBreakNextPage .Collapse wdCollapseEnd Call LayoutTransfer(DocSrc, DocTgt) .FormattedText = DocSrc.Range.FormattedText End With For Each HdFt In .Sections.Last.Headers HdFt.LinkToPrevious = False HdFt.Range.Text = vbNullString Next For Each HdFt In .Sections.Last.Footers HdFt.LinkToPrevious = False HdFt.Range.Text = vbNullString Next For Each HdFt In .Sections(.Sections.Count - 1).Headers With HdFt.Range .FormattedText = DocSrc.Sections.Last.Headers(HdFt.Index).Range.FormattedText .Characters.Last.Delete End With Next For Each HdFt In .Sections(.Sections.Count - 1).Footers With HdFt.Range .FormattedText = DocSrc.Sections.Last. Footers(HdFt.Index).Range.FormattedText .Characters.Last.Delete End With Next End With DocSrc.Close False End If strFile = Dir() Wend Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing Application.DisplayAlerts = wdAlertsAll Application.ScreenUpdating = True End Sub Sub LayoutTransfer(DocSrc As Document, DocTgt As Document) 'Document Body variables Dim sPageHght As Single, sPageWdth As Single Dim sHeaderDist As Single, sFooterDist As Single Dim sTMargin As Single, sBMargin As Single Dim sLMargin As Single, sRMargin As Single Dim sGutter As Single, sGutterPos As Single Dim lPaperSize As Long, lGutterStyle As Long Dim lMirrorMargins As Long, lVerticalAlignment As Long Dim lScnStart As Long, lScnDir As Long Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean Dim bOrientation As Boolean 'Get Page Setup parameters With DocSrc.Sections.First.PageSetup lPaperSize = .PaperSize lGutterStyle = .GutterStyle bOrientation = .Orientation lMirrorMargins = .MirrorMargins lScnStart = .SectionStart lScnDir = .SectionDirection lOddEvenHdFt = .OddAndEvenPagesHeaderFooter lDiffFirstHdFt = .DifferentFirstPageHeaderFooter lVerticalAlignment = .VerticalAlignment sPageHght = .PageHeight sPageWdth = .PageWidth sTMargin = .TopMargin sBMargin = .BottomMargin sLMargin = .LeftMargin sRMargin = .RightMargin sGutter = .Gutter sGutterPos = .GutterPos sHeaderDist = .HeaderDistance sFooterDist = .FooterDistance bTwoPagesOnOne = .TwoPagesOnOne bBkFldPrnt = .BookFoldPrinting bBkFldPrnShts = .BookFoldPrintingSheets bBkFldRevPrnt = .BookFoldRevPrinting End With 'Set Page Setup parameters With DocTgt.Sections.Last.PageSetup .GutterStyle = lGutterStyle .MirrorMargins = lMirrorMargins .SectionStart = lScnStart .SectionDirection = lScnDir .OddAndEvenPagesHeaderFooter = lOddEvenHdFt .DifferentFirstPageHeaderFooter = lDiffFirstHdFt .VerticalAlignment = lVerticalAlignment .PageHeight = sPageHght .PageWidth = sPageWdth .TopMargin = sTMargin .BottomMargin = sBMargin .LeftMargin = sLMargin .RightMargin = sRMargin .Gutter = sGutter .GutterPos = sGutterPos .HeaderDistance = sHeaderDist .FooterDistance = sFooterDist .TwoPagesOnOne = bTwoPagesOnOne .BookFoldPrinting = bBkFldPrnt .BookFoldPrintingSheets = bBkFldPrnShts .BookFoldRevPrinting = bBkFldRevPrnt .PaperSize = lPaperSize .Orientation = bOrientation End With End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
Last edited by macropod; 01-31-2018 at 01:40 PM.
Cheers
Paul Edstein
[Fmr MS MVP - Word]
No problem I just fiddled around with code written by the experts Greg, Graham & Paul. Thanks guys very useful macro.
Is there any way to merge documents that are attached (add obcject) to the word document?
What's my plan about how to choose files...
I have a form in Word document (.docm) from which I would like to choose which files (checking tick boxes) to merge those choosed files together while keeping text formating, numbering etc.
So I would like to link tick boxes to specific file then when te tick box are choosen only those choosed files will be merged.
From the code above you can only choose folder from whoom all files will be merged together, and my need is to go step further.
Is this make any sense?
Thanks.
In that case, start a thread that deals with what you want to do instead of hijacking a thread about something completely different.
Cheers
Paul Edstein
[Fmr MS MVP - Word]