Merge multiple Word Documents using VBA 2

[Cloonalt]

I have allow the user click a button to combine multiple Word documents into one, and then launch the final product. Any idea if this is possible?

(I'll know the names of the documents from a recordset)

Any help appreciated.

 

[Remou]

Perhaps something like:

Set oApp = CreateObject("Word.Application")
oApp.Visible = True

oApp.Documents.Add DocumentType:=wdNewBlankDocument

'Activate document for typing
oApp.Activate

Do While Not rs.EOF
    oApp.Selection.InsertFile _
        FileName:=CStr(rs!FileName), Range:=""
    rs.MoveNext
Loop
'Release reference
Set oApp = Nothing

 

[Cloonalt]

Remou,

Thanks for your help.

Do you think it's possible to open a Word document with the "insert document" statement running in the On Open event of the Word doc. and pass the document names to insert from my recordset?

Thanks.

 

[Remou]

I don't think so, unless you are thinking of connecting to Access using ADO to get your table of files to insert. Which end did you want to work from - Access or Word?

 

[Cloonalt]

I want to open a blank Word doc. from Access and then insert the documents.

Thanks for your help.

 

[Remou]

The code I posted first will open a blank word document and insert files that are found in a recordset. I did not include the bit about setting up a recordset. Here is my original post in more detail:

Dim oApp as Object
Dim rs As DAO.Recordset

'Set up incidence of Word
Set oApp = CreateObject("Word.Application")
'And make it visible
oApp.Visible = True

'Add a blank document to Word
oApp.Documents.Add DocumentType:=wdNewBlankDocument

'Activate document for typing
oApp.Activate

'I have called the field with the location of files to
'insert FileName and the table tblFiles. You must change
'these names to match your table and field.

Set rs = CurrentDB.OpenRecordset ("Select FileName From tblFiles")

'Loop through the file inserting files, one before 
'the next.
'It is assumed that FileName has the full address of 
'the file to be inserted.
Do While Not rs.EOF
    oApp.Selection.InsertFile _
        FileName:=CStr(rs!FileName), Range:=""
    rs.MoveNext
Loop
'Release reference
Set oApp = Nothing
rs.Close
Set rs=Nothing

I typed quite a lot of the above without testing, so I hope I have the syntax.

 

[Cloonalt]

Thanks again.

This is how I set it up:

Dim rs As DBResults
Dim strSQL As String
Dim Batch As Long
Dim Request As String
Dim NewDocument As String
Dim oapp As Object

Set oapp = CreateObject(Word.Application)
oapp.Visible = True

I get an error on the set line:
"object required error number 424"

I'm referencing object libraries DAO 3.6 and and Microsoft Office 11.0.

We're using Office 2003 Pro.

 

[Remou]

Oops, typing:
Set oapp = CreateObject("Word.Application")

 

[Cloonalt]

Great, that worked. Now I get

run time error 438. "Object doesn't support this property or method" on the second line below. I get no intellisense on oapp.


Do While Not rs.AtEnd
oapp.Selection.InsertFile _
FileName:=CStr(rs!psindex), Range:=""

rs.MoveNext
Loop


Thank you so much!!!

 

[Remou]

Which line is highlighted?

I am not familiar with:
rs.AtEnd
Usually, it is rs.EOF

 

[Cloonalt]

It fails on "oapp.Selection.InsertFile _"

Yes, this is a kind of proprietary application that uses VBA, so some things are a little different.

But,I understand that I should have everything available in Microsoft VBA.

Thanks.

 

[JerryKlmns]

Does this work?
Dim rs As DBResults

For intellisense on oapp, you 'll have to add a reference to Microsoft Word Object Library and declare
Dim oapp As Word.Application
But this is early binding with drawbacks and advantages ...

 

[Remou]

The line works for me (Office 2000), so I think we need to find which bit has changed since. Can you try:

oApp.Selection.InsertFile filename:="C:\Path\Filename.Doc"

That is, test with the name of a file. You mention that the application is slightly different, so it might be worth checking the syntax in Word. Or as, JerryKlmns mentions, try early binding during testing, it might highlight the syntax error.

 

[JerryKlmns]

Remou

I thought you said
Dim rs As DAO.Recordset

Cloonalt says
Dim rs As DBResults

Could be this?

 

[Remou]

I do not think so, as the error is It fails on "oapp.Selection.InsertFile _", which is the Word bit. Also, I do not think the code would run as far as to fail on this line if Cloonalt's kind of proprietary application that uses VBA did not accept DBResults as a proper declaration.

 

[Cloonalt]

Thank you for your help! Jerry, your suggestions got me intellisense.

This is my code. I made it simple by inserting the file name directly.

I'm getting 'object variable for with block not set', so I think my code is wrong.

Private Sub cmdWord_Click()

On Error GoTo ErrorHandler

Dim rs As DBResults
Dim strSQL As String
Dim Batch As Long
Dim Request As String
Dim oapp As Word.Application
Dim dir_path As String
Dim file_ext As String

Set oapp = CreateObject("Word.Application")
oapp.Visible = True

Batch = Me.txtBatchID
Request = Me.txtSearchDesc

strSQL = "Select psindex, psdesc from psearch where psdesc = " & "'" & Request & "'" & _
"ORDER BY psindex"

Set rs = Application.DB.OpenResults(strSQL)

If Not rs.AtEnd Then
With rs
Batch = rs.Value(psindex)
NewDocument = Batch & "001.doc"

If vbYes = MsgBox("Merge All Batch Files?", vbYesNo + vbQuestion) Then
Do While Not rs.AtEnd

oapp.Selection.InsertFile "S:\62088002.doc"

rs.MoveNext
Loop
End If
End With
End If

Exit Sub

ErrorHandler:

MsgBox "Error " & Err.Number & vbCr & _
"Location: " & "VBA.frmBatch.txtBatchID" & vbCr & _
Err.Description, vbOKOnly + vbExclamation, _
"Custom Conflicts Search"

End Sub

 

[Remou]

You seem to be missing a line:
oapp.Documents.Add DocumentType:=wdNewBlankDocument
Is need to add a new blank document, otherwise there is nothing for Word to work with.

 

[Cloonalt]

You guys are wonderful. That worked. Thank you!

 

[Cloonalt]

Can I check for the existence of a Word doc before I attempt to merge it, so that I can handle the error?

Thanks.

 

[Remou]

Yes.

On Error GoTo ErrorHandler

<...>
   
   Set appWord = GetObject(, "Word.Application")

<...>

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
    '  MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
    '  Resume ErrorHandlerExit
    Resume Next
   End If