Be the first user to complete this post

  • 0
Add to List

VBA-Excel - Merger - Merge or Combine Many Word Documents Into One

Download Link:WordMerger

If you want to combine or merger many word document into one file and you don’t want to do it manually, This piece of software will allow you merge as many word document you want, say 500-1000 word documents. This tool will provide you to option to select ot de-select word documents before merging.

How to Use it:

  1. Down­load the WordMerger.xlsm from the link pro­vided at the top and at the bot­tom of this article.
  2. Place all the Word documents, which you want to com­bine, into one folder (make sure all files are closed).
Word Merger -1
Word Merger -1

3. Open the WordMerger.xlsm.

Word Merger -2
Word Merger -2

4. Put the "Folder path" Example : " C:\Users\Sumit Jain\Desktop\Word Docs"
5. Put destination path for Merged Files : " C:\Users\Sumit Jain\Desktop\"
6. Click on Fetch Files . This will fetch files from the Folder and will display.

Fetch Button
Fetch Button
Fetch Files

7. Select or de-select files.

Select Files
Select Files

8. Click on Merge

Merge Button
Merge Button

9. Files will be mergred and saved at the given location.

Merged File
Merged File

Complete Code:

    'Dim fso As New FileSystemObject

    Dim NoOfFiles As Double

    Dim counter As Integer

    Dim r_counter As Integer

    Dim s As String

    Dim listfiles As Files

    Dim newfile As Worksheet

    Dim mainworkbook As Workbook

    Dim FetchFileClicked

    Dim Folderpath As Variant
Sub Sumit()
    If FetchFileClicked = False Then
        MsgBox "First click the 'Fetch Files' button"
    End If

    Application.ScreenUpdating = False
    strRandom = Replace(Replace(Replace(Now, ":", ""), "/", ""), " ", "")
    MergeFileName = "Merger" & strRandom & ".doc"
    MergeFolder = mainworkbook.Sheets("Main").Range("L10").Value

    Set objWord = CreateObject("Word.Application")

   Set objDoc = objWord.Documents.Add

   objWord.Visible = True

   Set objSelection = objWord.Selection
   objDoc.SaveAs (MergeFolder & MergeFileName)
    For i = 1 To NoOfFiles
        If Range("B" & i).Value = "Yes" Then
            Set objTempWord = CreateObject("Word.Application")
            Set tempDoc = objWord.Documents.Open(Folderpath & "\" & Range("A" & i).Value)
            Set objTempSelection = objTempWord.Selection
        End If
    Application.ScreenUpdating = True
    MsgBox "Completed...Merge File is saved at " & MergeFolder & MergeFileName
    FetchFileClicked = False
End Sub
Sub fetchFiles()
    Set mainworkbook = ActiveWorkbook

    Folderpath = mainworkbook.Sheets("Main").Range("L8").Value
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files
    counter = 0
    For Each fls In listfiles
        counter = counter + 1
        Range("A" & counter).Value = fls.Name
        Range("B" & counter).Value = "Yes"
        Range("A" & counter).Borders.Value = 1
        Range("B" & counter).Borders.Value = 1
        With Range("B" & counter).Validation
            'replace "=A1:A6" with the range the data is in.
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="Yes,No"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
     MsgBox "Files are Fetched,Please select the files to be merged"
     FetchFileClicked = True
End Sub

Download Link:WordMerger

Also Read:

  1. VBA-Excel: Create or Add Worksheets at the Run time.
  2. VBA-Excel: Create and Save the Word document
  3. VBA-Excel: Create a new Word Document
  4. VBA-Excel: Create worksheets with Names in Specific Format/Pattern.
  5. Excel-VBA : Send a Simple Mail From MS Outlook Using Excel