How to combine two documents using word (2000) VBA

Simple:

1) Create destination document
2) Select All, Copy and Paste from the first needed document into the destination
3) Do same with the second document

You're done. No need for FileSystemObject.

Cheers,

Andrew

I'm not sure what the correct VBA code would look like (I do WORD 2000 Automation with C#).

However to solve the problem with the second document being inserted in a funny location, instead of

'Put a page break at the end of the first document
Set wRng = wDoc.Range(wDoc.Characters.Count, wDoc.Characters.Count)
wRng.InsertBreak wdPageBreak

'Add the second document
Set wRng = wDoc.Range(wDoc.Characters.Count, wDoc.Characters.Count)
wRng.InsertFile FileName:=strDoc2

try (something like) this...

Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd

wRng.InsertBreak wdPageBreak

Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd

wRng.InsertFile FileName:=strDoc2

wDoc.Content should return the range of the entire document (well technically the section that contains the wholestory (not the header/footer sections).  wRng.Collapse wdCollapseEnd collapses the range to the end.

Let me know if that helps,
Justin

Thanks justin, excellent solution, the only hitch (that i've subsequently realised) is that the second document has different  header and footer settings to the first, and I need to preserve them... this is proving problematic since I don't know how to tell word the range of the second document  subsequent  to insertion (or indeed tell word to change the formatting from the end of the first document)  

I'll give you the points anyway, but I would apppreciiate it if you had any advice on this matter...

Here's the code at the moment

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Add
With wDoc.PageSetup
    .TopMargin = CentimetersToPoints(1)
    .BottomMargin = CentimetersToPoints(2.54)
    .HeaderDistance = CentimetersToPoints(1.27)
    .FooterDistance = CentimetersToPoints(0.4)
End With

Set wRng = wDoc.Content
wRng.InsertFile FileName:=strDoc1

wRng.Collapse wdCollapseEnd
wRng.InsertBreak wdPageBreak

Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd
Set wRngI = wDoc.Content.End


wRng.InsertFile FileName:=strDoc2

With wDoc.Range(wRngI, wDoc.Content.End).PageSetup
     .TopMargin = CentimetersToPoints(0.1)
    .BottomMargin = CentimetersToPoints(1.5)
    .HeaderDistance = CentimetersToPoints(0.5)
    .FooterDistance = CentimetersToPoints(1.27)
End With

wDoc.SaveAs FileName:=strResult

Of course it doesn like the line Set wRngI = wDoc.Content.End, because .end returns a character position rather than a range object so 've tried Set wRngI = Range(wDoc.Content.End, wDoc.Content.End), but it doesn't like that either....

OK.  So what I'm understanding the problem is is you need / want to preserve the headers for each document...  If this is the case then (I haven't actually done/toyed with this, but from my understanding of the Word Object Model) you have to add the second document to a new section.  Each section of a document has it's own headers/footers.  Let me play with some code real quick here and see if I can make something happen...

Actually I didn't make myself clear, sorry it's not so much the headers and footers which are the issue, it's the page setup parameters (including the header and footer offsets).  The different pages have different page settings, hence the .TopMargin = CentimetersToPoints(0.1)
    .BottomMargin = CentimetersToPoints(1.5) etc.

What I'm trying to do is preserve the individual settings for both documents that get added, sorry for the confusion.

Dang it... after just figuring out how to preserve the headers/footers... Let me take a look.  I think the two issues are semi related (at least in how to deal with them).  I'll post back in a bit.

Justin

I think I have a solution!  Again, I wrote my solution in C# so the VBA (guess) code might not be 100% on.  The method of inserting the files has changed (it should allow for more control and the abililty to get other properties about the actual documents, such as maintaining headers/footers if you choose (I have that 'solution' too)).  We will open each document to be inserted instead of using the InsertFile method.  This will mean instead of hard coding the pagesetup information, the pagesetup from the documents to be inserted will be 'pulled' and used.  I tried my best converting the C# to VBA.  Let me know if that works and what troubles,if any, you have.

Justin

Here we go...

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Add

'Open the first file to be inserted.
Set wDocTemp = wApp.Documents.Open Filename:=strDoc1

'Insert the first file by setting the content range.
Set wDoc.Content = wDocTemp.Content

'Get the number of sections in the document
numOfSectionsInFirstDoc = wDoc.Sections.Count

'For each section in final doc set the pagesetup equal to the corresponding section in temp doc.
For index = 1 To numOfSectionsInFirstDoc
      Set wDoc.Sections.Item(index).PageSetup = wDocTemp.Sections.Item(index).PageSetup
Next index

'Close wDocTemp
wDocTemp.Close SaveChanges:=false

'Get to the end of wDoc
Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd

'Insert a page break
wRng.InsertBreak wdPageBreak

'Insert new section
wRng.InsertBreak wdSectionBreakContinuous

'Open second document to be inserted
Set wDocTemp = wApp.Documents.Open Filename:=strDoc2

'This section might not be needed but just in case... Get to the end of wDoc
Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd      

wRng = wDocTemp.Content

'Calculate number of sections in second document
numOfSectionsInSecondDoc = wDoc.Sections.Count - numOfSectionsInFirstDoc

'For each section in final doc set the pagesetup equal to the corresponding section in temp doc.
For index = 1 To numOfSectionsInSecondDoc
      Set wDoc.Sections.Item(index + numOfSectionsInFirstDoc).PageSetup =                   wDocTemp.Sections.Item(index).PageSetup
Next index

'Close wDocTemp
wDocTemp.Close SaveChanges:=false

'Save the final doc
wDoc.SaveAs FileName:=strResult

My biggest concern is getting an 'off by one error' with the sections involved in the for loops.  Please double check and test the logic.  Thanks.

I suppose you could do this instead...

'Get the number of sections in the document
numOfSectionsInFirstDoc = wDocTemp.Sections.Count

And...

'Calculate number of sections in second document
numOfSectionsInSecondDoc = wDocTemp.Sections.Count


It might make more sense when readingover the code...  try it if you like.
 

One other thing, inserting the page break might not be neccesary.  If you are getting an extra page in between the documents remove it.

'Get to the end of wDoc
Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd

'Insert a page break. NOTE: MIGHT NOT BE NECCESARY.
wRng.InsertBreak wdPageBreak

'Insert new section
wRng.InsertBreak wdSectionBreakContinuous

I'm really concerned about the For loops.  The following are the correct While/Wend loops, check to see if the For loops are equvialent. The key thing to note is <=.

index = 1

While (index <= numOfSectionsInFirstDoc)
   Set wDoc.Sections.Item(index).PageSetup = wDocTemp.Sections.Item(index).PageSetup
   index = index + 1
Wend

And...

index = 1

While (index <= numOfSectionsInSecondDoc)
   Set wDoc.Sections.Item(index + numOfSectionsInFirstDoc).PageSetup =
      wDocTemp.Sections.Item(index).PageSetup

   index = index + 1
Wend

OK one more slight hurdle ....
looking closely at the code above at this point ... It looks like we're overwriting wRng which would lose the stuff we already have ?

'Open second document to be inserted
Set wDocTemp = wApp.Documents.Open Filename:=strDoc2

'This section might not be needed but just in case... Get to the end of wDoc
Set wRng = wDoc.Content
wRng.Collapse wdCollapseEnd    

wRng = wDocTemp.Content   <-overwriting the range with doc2 ?

I've trried using using
wRng.InsertFile FileName:=strDoc2

at this point  but stll seem to have lost the content from doc1

Another problem.....

OK the good news is that the two docs have been amalgamated

The bad news is that

Set wDoc.Content = wDocTemp.Content

loses the table formatting, and also a graphic which is embedded in the first document.  But I think I see the way to go now

Since I'm amalgamating only two documents each with one section, I can use the original .InsertFile technique and then apply the pagesetup from each  document to the resepective sections

will try that and let you know

OK
this seems to be the final solution, I tend to think that copying and pasting is a kludge, but it works so ....

Public Function UniteDocsIII(strDoc1 As String, strDoc2 As String, strResult As String) As Boolean
'Unites two documents as one
'Doc2 is placed at the end of Doc1
'The new document is saved as strResult

Dim fso As New FileSystemObject
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wTDoc As Word.Document
Dim wSRng As Word.Range   'source Range
Dim wDRng As Word.Range   'Destination range


On Error GoTo proc_err

If fso.FileExists(strResult) Then
    fso.DeleteFile (strResult)
End If

SetStatus "Combining documents...."

Set wApp = New Word.Application
Set wDoc = wApp.Documents.Add

Set wTDoc = wApp.Documents.Open(FileName:=strDoc1)
Set wSRng = wTDoc.Content
wSRng.Copy
wDoc.Range(0, 0).Paste
wTDoc.Close

Set wDRng = wDoc.Content

wDRng.Collapse wdCollapseEnd
wDRng.InsertBreak Type:=wdSectionBreakNextPage
wDRng.Collapse wdCollapseEnd

Set wTDoc = wApp.Documents.Open(FileName:=strDoc2)
Set wSRng = wTDoc.Content
wSRng.Copy

wDRng.Paste
wTDoc.Close
wDoc.SaveAs FileName:=strResult
wDoc.Close

Set wApp = Nothing

UniteDocsIII = True

proc_exit:
Exit Function

proc_err:

Select Case ErrHand()
Case ErrAbort
    UniteDocsIII = False
    Resume proc_exit
Case ErrRetry
    Resume
Case ErrIgnore
    Resume Next
End Select

End Function