Need help combining documents with the same template

[sullenest]

Hello,

Word only allows combining two documents at a time. Is there a way to use VBA to combine multiple documents (not append at the end, but combine) that are using the same template. Basically, I have created a main template where different users put in their comments. I need to merge and combine them together into one document.

I found an old code that probably worked with 2003, but after FileSearch function was removed in 2007 it doesn't work anymore. Appreciate your help very much.

Option Explicit
Sub MergeDocuments()
Dim iFile As Integer
With Application.FileSearch
.FileType = msoFileTypeWordDocuments
'change the folder to the merge documents folder
.LookIn = "C:\My documents to merge folder"
.Execute

For iFile = 1 To .FoundFiles.Count
MergeDocument (.FoundFiles(iFile))
Next
End With

If iFile <> 0 Then
MsgBox ("The code finished merging: " & CStr(iFile - 1) & " documents")
End If
End Sub
Sub MergeDocument(sPath As String)
Application.ScreenUpdating = False
ActiveDocument.Merge FileName:=sPath, _
MergeTarget:=wdMergeTargetSelected, DetectFormatChanges:=True, _
UseFormattingFrom:=wdFormattingFromPrompt, AddToRecentFiles:=False
End Sub

[MacroShadow]

I haven't tested it, but this should work (partially from MVP site):
Sub MergeDocuments()
Dim iFile As Integer
Dim MyFile As String
Dim Counter As Long

'Create a dynamic array variable, and then declare its initial size
Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000)

'Loop through all the files in the directory by using Dir$ function
MyFile = Dir$("C:\My documents to merge folder*.doc*")
Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1
Loop

'Reset the size of the array without losing its values by using Redim Preserve
ReDim Preserve DirectoryListArray(Counter - 1)

For iFile = 1 To DirectoryListArray(Counter)
MergeDocument (DirectoryListArray(iFile))
Next

If iFile <> 0 Then
MsgBox ("The code finished merging: " & CStr(iFile - 1) & " documents")
End If
End Sub
Sub MergeDocument(sPath As String)
Application.ScreenUpdating = False
ActiveDocument.Merge FileName:=sPath, _
MergeTarget:=wdMergeTargetSelected, DetectFormatChanges:=True, _
UseFormattingFrom:=wdFormattingFromPrompt, AddToRecentFiles:=False
End Sub

[MacroShadow]

You may also want to look into this: http://www.mrexcel.com/forum/showpost.php?p=2551004&postcount=10

[sullenest]

Thanks for the code, but I keep getting subscript out of Range error. Not sure why?

[MacroShadow]

I guess the solution is too long to be posted, attached you will find your solution, both in the document it self and also in the VBE.