Merging two Word documents into one from Excel

[Rejje]

Why don't I get this to work?

I have found this example that solves an immediate issue for me. That is if I get to work at least! What I need is a macro that merges 2 Word documents into 1.

WrdDoc1 + WrdDoc2 = WrdDoc3

Note! Code is in Excel and as this was originally intended for Word as comments show. I have altered the code some to try to get it to work but I get: "Run time error 438 - the object does not support the attribute or the method... (translated from Swedish)" at "Selection.TypeText Text:=paragraphText"


' Start Microsoft Word 2007. Select the "Developer" tab and click "Visual Basic." Right-click "Microsoft Word Objects," click "Insert" and select "Module."
' Type the following to create a new sub:
Sub MergeTwoDocs()
' Type the following to create variables used for storing data:
Dim wrdApp As Object
Dim wrdDoc As Word.Document
Dim paragraphText As String
Dim paragraphRange As Word.Range
Dim paragraphCount As Long
' Type the following to define your "wordApplication" variable:
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

' Type the following to open the "first" document to merge:
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\...\629F36\1.docx")
' Type the following to call the "readDocument" sub and send the "first" document object as a parameter:
Call readDocument(wrdDoc)
' Type the following to open the "second" document to merge:
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\...\629F36\2.docx")
' Type the following to call the "readDocument" sub and send the "second" document object as a parameter:
Call readDocument(wrdDoc)
End Sub


' Type the following to create the "readDocument" sub that will read any word document object passed in and add the contents to the current document:
Private Sub readDocument(wrdDoc As Object)
With wrdDoc
For paragraphCount = 1 To .Paragraphs.Count

Set paragraphRange = .Range(Start:=.Paragraphs(paragraphCount).Range.Start, _
End:=.Paragraphs(paragraphCount).Range.End)
paragraphText = paragraphRange.Text
Selection.TypeText Text:=paragraphText
Selection.TypeParagraph

Next paragraphCount
.Close
End With
End Sub

[Kenneth Hobs]

Note the With. That means that you prefix with a period for that object.
.Selection.TypeText Text:=paragraphText

Selection is a property of Excel and MSWord.

[jacques]

Hi,
Using Office Pro 2010,
We have a run Time error 438 'object doesn't support this property or method'
on line
.Selection.paragraphText = paragraphRange.Text
Could you please help on this ?
Thank you so much. Jacques

[snb]

Forget that code:
This is all you need.


Sub M_snb()
c00=getobject("G:\OF\doc1.docx").content & getobject("G:\OF\doc2.docx").content
End Sub


The contents of doc1.docx and doc2.docx are being merged into the variable c00.
Since you didn't indicate what should happen next I can't give any further advice.


If you want so save a new file that contains both contents:


Sub M_snb()
with Getobject("G:\OF\doc1.docx")
.content.insertafter getobject("G:\OF\doc2.docx").content
.saveas2 "G:\doc3.docx",12
.close False
end with
End Sub

[jacques]

Thank you SNB. In fact this is the scenario:
A.docx, B.docx are opened
Merge data on each (.Bookmarks("date").Range.Text = Now)
Browse, select and open another .docx file (C.docx)
This works fine with the code below.

I need to:
Combine A.docx, B.docx in C.docx
Close A.docx, B.docx without saving


Sub Merge_docx()

With ActiveSheet
Dim strFindString As String
Dim intActualRow As Integer

Dim wdApp As Word.Application
Dim wdDoc As Word.Document

For intActualRow = 4 To 6 'rows contain .docx path
strFindString = Sheets("Program").Cells(intActualRow, 7).Value 'strFindString=.docx path

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If

On Error Resume Next
Set wdDoc = wdApp.Documents.Open(strFindString)

If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
Exit Sub
End If

wdApp.Visible = True

With wdDoc
.Bookmarks("date").Range.Text = Now
End With

Set wdDoc = Nothing
Next

Application.DefaultFilePath = Sheets("User Settings").Cells(103, 2).Value

strFindString = Application.GetOpenFilename("Text Files (*.docx), *.docx") 'let's name it C.docx

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If

On Error Resume Next
Set wdDoc = wdApp.Documents.Open(strFindString)

If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
Exit Sub
End If

wdApp.Visible = True

'******************WHAT I NEED HERE******************************
'2-Combine A.docx, B.docx in C.docx
'3-Close A.docx, B.docx without saving

End With
End Sub

[snb]

The 3 lines of code I posted suffice.

Read it, analyse it ( using F8 ) and find out for yourself.

[patel]

snb
your code works well on excel 2010, but only with doc files, not with docx files, do you know why ?

[snb]

@Patel

I checked: no problem using docx files in 2010.
Did you check the extra / 'mapoptions' / filetypes in the explorer ?

[patel]

Yes, I checked, I saved the same document as docx and as doc, but I receive runtime error 432 with docx

[snb]

what about

Sub M_snb()
msgbox dir("G:\OF\document1.docx")
msgbox dir("G:\OF\document2.docx")

With Getobject("G:\OF\document1.docx")
.content.insertafter getobject("G:\OF\document2.docx").content
.saveas2 "G:\OF\document3.docx",12
.close False
End With
End Sub

[patel]

the 2 msgboxes show the correct file name (without path), then same error.
no error with doc files

[snb]

What if you activate the reference to the Microsoft Word 14.0 Object library in the Excel/VBEditor/Extra/references/ list ?

Can you open a docx file using the explorer ?

[patel]

I activated the reference to the Microsoft Word 14.0 Object library i

I can open a docx file using the explorer

[goldfish]

Need help please.

Selection.InsertAfter GetObject("C:\doc2.dot").Content

The GetObject().Content takes the content of the word doc and paste it into existing word doc without retaining the format from source document.

Can you please please guide me on how to getobject and retain the format from the other word doc, please?

[snb]

Did you try ?


GetObject("C:\doc2.dot").Content.Formattedtext

[goldfish]

Tried but still only the content is copied over without retaining the format from the document.

Any more suggestions, please?

[goldfish]

Did you try ?


GetObject("C:\doc2.dot").Content.Formattedtext

Hi, I really need your help please?
Any other suggestion besides .FormattedText?

[macropod]

You cannot reliably get the desired result using code such as snb has suggested. There is far more to replicating one document in another than just reproducing the body content via copy/paste or the FormattedText method. There are different page layouts, headers, footers, and so on to consider as well. To see how to do this properly, have a look at: http://www.vbaexpress.com/forum/showthread.php?51797-Macro-to-merge-mulitple-word-doc-into-one-word-doc&p=354835&viewfull=1#post354835

[SamT]

If Macropod's link doesn't help you, please start another thread.

I have closed this 6yo one.