Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 40 of 40

Thread: Macro to merge mulitple word doc into one word doc

  1. #21
    VBAX Contributor
    Joined
    Nov 2014
    Posts
    121
    Location
    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

  2. #22
    VBAX Newbie
    Joined
    Apr 2016
    Posts
    4
    Location

    Brilliant but what about retaining formatting?

    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?

  3. #23
    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

  4. #24
    VBAX Newbie
    Joined
    Apr 2016
    Posts
    4
    Location
    Quote Originally Posted by gmayor View Post
    No - that's as good as it gets. Combining disparate document formats will always be a compromise.

    That is terribly heartbreaking.

  5. #25
    VBAX Regular
    Joined
    Jun 2016
    Posts
    53
    Location
    Hello everyone,

    i am using the code from gmayor to merge multiple documents into a single 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
    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

  6. #26
    The code in question creates the base document using the normal template
    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

    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

  7. #27
    VBAX Regular
    Joined
    Jun 2016
    Posts
    53
    Location
    Quote Originally Posted by gmayor View Post
    The code in question creates the base document using the normal template
    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

    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?

  8. #28
    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:
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #29
    VBAX Regular
    Joined
    Jun 2016
    Posts
    53
    Location
    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.

  10. #30
    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

  11. #31
    VBAX Regular
    Joined
    Jun 2016
    Posts
    53
    Location
    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.

  12. #32
    VBAX Newbie
    Joined
    Jan 2017
    Posts
    2
    Location
    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.

  13. #33
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    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

  14. #34
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by gmayor View Post
    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.
    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]

  15. #35
    VBAX Newbie
    Joined
    Jan 2017
    Posts
    2
    Location

    Brilliant

    Quote Originally Posted by Kilroy View Post
    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
    was Perfect, Thank you.

  16. #36
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    No problem I just fiddled around with code written by the experts Greg, Graham & Paul. Thanks guys very useful macro.

  17. #37
    VBAX Newbie
    Joined
    Apr 2017
    Posts
    4
    Location
    Is there any way to merge documents that are attached (add obcject) to the word document?

  18. #38
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by tomaszko View Post
    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?
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  19. #39
    VBAX Newbie
    Joined
    Apr 2017
    Posts
    4
    Location
    Quote Originally Posted by macropod View Post
    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.

  20. #40
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •