Macro to merge mulitple word doc into one word doc

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.

Quote:

---

Originally Posted by gmayor

No - that's as good as it gets. Combining disparate document formats will always be a compromise.

---

That is terribly heartbreaking.

Hello everyone,

i am using the code from gmayor to merge multiple documents into a single document.

Code:

---

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

---

It is doing what it is supposed to do, but i am having a specific problem with the merged document.
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 template

Code:

---

Set MainDoc = Documents.Add

---

You 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.htm

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

The code in question creates the base document using the normal template

Code:

---

Set MainDoc = Documents.Add

---

You 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.htm

Code:

---

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

---

---

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:

Code:

---

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

---

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.

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


Attachment 17134
The documents are protected? Protected how?

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.

Code:

---

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

---

[/QUOTE]

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

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

No - that's as good as it gets. Combining disparate document formats will always be a compromise.

---

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.

Code:

---

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

---

Quote:

---

Originally Posted by Kilroy

Minor change. Works for me

Code:

---

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

---

---

was Perfect, Thank you.

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?

Quote:

---

Originally Posted by tomaszko

Is there any way to merge documents that are attached (add obcject) to the word document?

---

Given that the topic of this thread is all about merging multiple documents into one, perhaps you could clarify what you want that isn't already covered?

Quote:

---

Originally Posted by macropod

Given that the topic of this thread is all about merging multiple documents into one, perhaps you could clarify what you want that isn't already covered?

---

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.