|
Be the first user to complete this post
|
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:
- Download the WordMerger.xlsm from the link provided at the top and at the bottom of this article.
- Place all the Word documents, which you want to combine, into one folder (make sure all files are closed).

3. Open the WordMerger.xlsm.

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.


7. Select or de-select files.

8. Click on Merge

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

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
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
tempDoc.Range.Select
tempDoc.Range.Copy
objSelection.TypeParagraph
objSelection.Paste
tempDoc.Close
End If
Next
objDoc.Save
Application.ScreenUpdating = True
mainworkbook.Sheets("Main").Activate
MsgBox "Completed...Merge File is saved at " & MergeFolder & MergeFileName
FetchFileClicked = False
End Sub
Sub fetchFiles()
Set mainworkbook = ActiveWorkbook
Range("A:A").Clear
Range("B:B").Clear
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
.Delete
'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
Next
MsgBox "Files are Fetched,Please select the files to be merged"
FetchFileClicked = True
End Sub
Download Link:WordMerger
Also Read:
- VBA-Excel: Get ALL The Opened Internet Explorer (IE) using Microsoft Excel
- VBA-Excel: Format already written text in a word document – Format Paragraphs
- VBA-Excel: Format the Existing Table in a Word document
- Excel-VBA : Insert Multiple Images from a Folder to Excel Cells
- Excel-VBA : Send a Simple Mail From MS Outlook Using Excel