Merge Word Docs from Excel's VBA

[Ronnet2]

Hi all,

Is it possible for Excel's VBA to merge Word docs into one document?

It needs to from Excel since in Excel I have a list of word documents. The order of the docs in this list determines the order in which they need to be merged. For example:

Excel's list range ("A1:A3"):
Cell A1: Important Papers
Cell A2: Resources
Cell A3: Something else

Related files:
H:\MergeDocs\Something else.docx
H:\MergeDocs\Important Papers.docx
H:\MergeDocs\Resources.docx

It would be great if Excel could look through range("A1:A3") and merge the docs in 'H:\MergeDocs' in the order that they appear in Excel. Is this even possible?

 

[Macropod]

The basics are pretty simple (in VBA terms), but the devil is in the detail. If any of the documents has a different page layout (e.g. margins, orientation, page size) or has a different page setup (e.g. odd/even), has different definitions for Styles, or uses the same bookmark names for cross-references used in any of the others, or if more than one of them has paragraph numbering, things start getting very complicated, very quickly.

 

[Ronnet2]

The basics are pretty simple (in VBA terms), but the devil is in the detail. If any of the documents has a different page layout (e.g. margins, orientation, page size) or has a different page setup (e.g. odd/even), has different definitions for Styles, or uses the same bookmark names for cross-references used in any of the others, or if more than one of them has paragraph numbering, things start getting very complicated, very quickly.

The good news is that even though I used unrelated doc names in the given example, in the real case it concerns documents with the same layout all based on the same template. So page setup, styles and such are not an issue.

 

[Macropod]

In that case, you might try:

Sub Demo()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDocTgt As Word.Document, wdDocSrc As Word.Document, r As Long
Set wdDocTgt = wdApp.Documents.Add
wdApp.Visible = False
With ActiveSheet
  For r = 1 To .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
  Set wdDocSrc = wdApp.Documents.Open(Filename:=.Range("A" & r).Value, ReadOnly:=True, AddToRecentFiles:=False)
  With wdDocTgt.Range
    .Collapse Direction:=wdCollapseEnd
    .InsertBreak Type:=wdPageBreak
    .Collapse Direction:=wdCollapseEnd
    .FormattedText = wdDocSrc.Range.FormattedText
  End With
  wdDocSrc.Close SaveChanges:=False
  Next
End With
wdApp.Visible = True
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing: Set wdApp = Nothing
End Sub

For testing, you might want to change 'wdApp.Visible = False' to 'wdApp.Visible = True'.

 

[Ronnet2]

In that case, you might try:

Sub Demo()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDocTgt As Word.Document, wdDocSrc As Word.Document, r As Long
Set wdDocTgt = wdApp.Documents.Add
wdApp.Visible = False
With ActiveSheet
  For r = 1 To .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
  Set wdDocSrc = wdApp.Documents.Open(Filename:=.Range("A" & r).Value, ReadOnly:=True, AddToRecentFiles:=False)
  With wdDocTgt.Range
    .Collapse Direction:=wdCollapseEnd
    .InsertBreak Type:=wdPageBreak
    .Collapse Direction:=wdCollapseEnd
    .FormattedText = wdDocSrc.Range.FormattedText
  End With
  wdDocSrc.Close SaveChanges:=False
  Next
End With
wdApp.Visible = True
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing: Set wdApp = Nothing
End Sub

For testing, you might want to change 'wdApp.Visible = False' to 'wdApp.Visible = True'.

Thanks for the code! I got the code to work until line "With wdDocTgt.Range".
At this point I get the following error: -2147417848 (80010108) automation error the object invoked has disconnected from its clients
What can be causing this?

 

[Macropod]

I got the code to work until line "With wdDocTgt.Range".
At this point I get the following error: -2147417848 (80010108) automation error the object invoked has disconnected from its clients
What can be causing this?

I have no idea what the cause is. Have you tried re-starting Excel/Windows? Are you sure the Excel row being referenced when the error occurs has a valid file path & name?

 

[Ronnet2]

I'm not sure why but I was able to avoid the error by changing the order in the lines as such:

Sub GenerateWeeklyMessages()
On Error Resume Next
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDocTgt As Word.Document, wdDocSrc As Word.Document, r As Long
Set wdDocSrc = wdApp.Documents.Add
Set wdDocTgt = wdApp.Documents.Add
wdApp.Visible = True
With Generator
For r = 9 To 11
Set wdDocSrc = wdApp.Documents.Open(Filename:=.Range("N4").Value & .Range("D" & r).Value & ".docx", ReadOnly:=True, AddToRecentFiles:=False)

With wdDocTgt.Range
.Collapse Direction:=wdCollapseEnd
'.InsertBreak Type:=wdPageBreak
.Collapse Direction:=wdCollapseEnd
.FormattedText = wdDocSrc.Range.FormattedText
End With
wdDocSrc.Close SaveChanges:=False
Next
End With
wdApp.Visible = True
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing: Set wdApp = Nothing
End Sub

Anyway, now it works so thansk again!

 

[Ronnet2]

I'm having difficulty adding a white line (enter) after each merged doc.

I tried the following:

With wdDocTgt.Range
    .Collapse Direction:=wdCollapseEnd
    '.InsertBreak Type:=wdPageBreak
    .Collapse Direction:=wdCollapseEnd
    [COLOR=#FF8C00].InsertParagraph[/COLOR]
    .FormattedText = wdDocSrc.Range.FormattedText
  End With

And:

wdDocTgt.content.InsertParagraphAfter

What am I doing wrong?

 

[Macropod]

With a bit of thought it should have been evident you need to replicate the original structure. So, if you're not going to have a page break between the inserted documents, you'd use:

  With wdDocTgt.Range
    .Collapse Direction:=wdCollapseEnd
    '.InsertBreak Type:=wdPageBreak
    .InsertParagraph
    .Collapse Direction:=wdCollapseEnd
    .FormattedText = wdDocSrc.Range.FormattedText
  End With

That said, the code in this case could be reduced to:

    With wdDocTgt.Range
      .InsertAfter vbCr
      .Collapse Direction:=wdCollapseEnd
      .FormattedText = wdDocSrc.Range.FormattedText
    End With

 

[Ronnet2]

With a bit of thought it should have been evident you need to replicate the original structure. So, if you're not going to have a page break between the inserted documents, you'd use:

  With wdDocTgt.Range
    .Collapse Direction:=wdCollapseEnd
    '.InsertBreak Type:=wdPageBreak
    .InsertParagraph
    .Collapse Direction:=wdCollapseEnd
    .FormattedText = wdDocSrc.Range.FormattedText
  End With

That said, the code in this case could be reduced to:

    With wdDocTgt.Range
      .InsertAfter vbCr
      .Collapse Direction:=wdCollapseEnd
      .FormattedText = wdDocSrc.Range.FormattedText
    End With

The .InsertParagraph command doesnt work for me. Im getting the following error:

Run-time error '4605':

The Unprotect method or property is not available because this command is not available for reading.