merge word documents from excel macro

[lieven]

Hello,

I want to create a marcro in excel that allows me to merge different word
documents.
Can anyone point me in the wright direction?

Thanks

Lieven

 

[Jacob Skaria]

Hi, try the below macro and feedback

--You can specify the files (with path) in the variable strFiles . In the
below example I have given 3 files with their full path (comma separated)

--Edit Save As file/path . In the below example it is given as
"c:\merge1.doc". Either assign this to a variable or edit for testing.

Sub MergeWordDocs()

Dim wrdApp As Word.Application, strFile As String
Dim wrdDoc As Word.Document, wrdNew As Word.Document

Set wrdApp = CreateObject("Word.Application")
Set wrdNew = wrdApp.Documents.Add

strFiles = "c:\1.doc,c:\2.doc,c:\Quick Response SLA.doc"

For intTemp = 0 To UBound(Split(strFiles, ","))
Set wrdDoc = wrdApp.Documents.Open(Split(strFiles, _
",")(intTemp), ReadOnly:=True)
wrdDoc.Range.Copy
Set myRange = wrdNew.Range(wrdNew.Content.End - 1, _
wrdNew.Content.End - 1)
myRange.Paste
wrdDoc.Close False: Set wrdDoc = Nothing
Next

wrdNew.SaveAs "c:\merge1.doc": wrdNew.Close True
wrdApp.Quit: Set wrdApp = Nothing
End Sub


If this post helps click Yes

 

[Jacob Skaria]

Forgot to mention that the previous post works only if you refer 'Microsoft
Word xx.0 Object Library' from VBE>Tools>References.

OR othewise use the below version...which creates the object at runtime..

Sub MergeWordDocs()

Dim wrdApp As Object, strFile As String
Dim wrdDoc As Object, wrdNew As Object
Set wrdApp = CreateObject("Word.Application")
Set wrdNew = wrdApp.Documents.Add

strFiles = "c:\1.doc,c:\2.doc,c:\Quick Response SLA.doc"

For intTemp = 0 To UBound(Split(strFiles, ","))
Set wrdDoc = wrdApp.Documents.Open(Split(strFiles, _
",")(intTemp), ReadOnly:=True)
wrdDoc.Range.Copy
Set myRange = wrdNew.Range(wrdNew.Content.End - 1, _
wrdNew.Content.End - 1)
myRange.Paste
wrdDoc.Close False: Set wrdDoc = Nothing
Next

wrdNew.SaveAs "c:\merge1.doc": wrdNew.Close True
wrdApp.Quit: Set wrdApp = Nothing

End Sub


If this post helps click Yes