Open and paste into existing Word document errors if Word already open

Question

I am using Excel VBA to open an existing Word document (based on directory and filename entered on Excel worksheet) and then copy and paste a table from active Excel workbook, leaving the Word document open for the user to manually arrange.

The code below works fine if Word is not already open but if Word is already open it will open the document but when it goes to paste it errors (Jumping to the error handler for document not found).

How can I pick the required Word document from multiple open Word documents to then paste to?

Sub Einsueb()

Dim wdApp As Object
Dim wdDoc As Object
Dim ws As String
Dim EinsuebPath As String

' x - Defined Cell Names , DFEinsueb , DFEinsuebDOC , DFEinsuebRng


On Error GoTo errHandler

EinsuebPath = ActiveSheet.Range("DFEinsueb").Value & ActiveSheet.Range("DFEinsuebDOC").Value  ' x

Range("DFEinsuebRng").Select   ' x
    Selection.Copy
    Set wdApp = CreateObject("Word.application")
    wdApp.Visible = True
    wdApp.Activate
    Set wdDoc = wdApp.Documents.Open(FileName:=EinsuebPath)

    ' This is Word VBA code, not Excel code

    Word.ActiveDocument.Bookmarks("New_Case").Range.Paste

    '    wdDoc.Close savechanges:=False
    Set wdDoc = Nothing
    '    wdApp.Quit
    Set wdApp = Nothing

'  stop macro if error

exitHandler:

Exit Sub

errHandler:

MsgBox "                  Word Document not found" & vbNewLine & vbNewLine & _
       "    Check that correct Document name and directory" & vbNewLine & _
       "                          have been entered"
Resume exitHandler

End Sub

Answer 1

You are referencing the correct word document, but you are not using the reference. Instead of

Word.ActiveDocument.Bookmarks("New_Case").Range.Paste

try

wdDoc.Bookmarks("New_Case").Range.Paste

Please note that this is not tested. Please comment whether this worked or not.

Answer 2

How can I pick the required word document from multiple open word documents to the paste to?

This would be best accomplished with a UserForm, which you could configure to display a list of all open word documents. However, I think what you're asking is

how can I avoid the error if the file identified by EinsuebPath is already open?

Simple. Check to see if the document is already open!

Sub Einsueb()

Dim wdApp As Object
Dim wdDoc As Object
Dim ws As String
Dim EinsuebPath As String

' x - Defined Cell Names , DFEinsueb , DFEinsuebDOC , DFEinsuebRng


On Error GoTo errHandler

EinsuebPath = ActiveSheet.Range("DFEinsueb").Value & ActiveSheet.Range("DFEinsuebDOC").Value  ' x

Range("DFEinsuebRng").Select   ' x
    Selection.Copy
    Set wdApp = CreateObject("Word.application")
    wdApp.Visible = True
    wdApp.Activate
    Set wdDoc = GetWordDocument(wdApp, EinsuebPath) 

    ' #### ALSO CHANGE THIS LINE:
    '    Word.ActiveDocument.Bookmarks("New_Case").Range.Paste
    wdDoc.Bookmarkes("New_Case").Range.Paste

    '    wdDoc.Close savechanges:=False
    Set wdDoc = Nothing
    '    wdApp.Quit
    Set wdApp = Nothing

'  stop macro if error

exitHandler:

Exit Sub

errHandler:

MsgBox "                  Word Document not found" & vbNewLine & vbNewLine & _
       "    Check that correct Document name and directory" & vbNewLine & _
       "                          have been entered"
Resume exitHandler

End Sub

I will use a custom function to first attempt to access the file (assuming it's open). If that statement errors, then it will attempt to open the document.

Function GetWordDocument(WordApp as Object, filePath as String)
Dim ret
Dim filename as string
filename = Dir(filePath)
'Make sure you've supplied a valid file path:
If filename = VbNullString Then
    Set ret = Nothing
    MsgBox "Invalid file path!", vbInformation
    GoTo EarlyExit
End If

On Error Resume Next
'Assume the file may already be open
Set ret = WordApp.Documents(filename)

'If the file isn't open, the above line will error
' so, open the file from it's full path:
If Err.Number <> 0 Then
    Set ret = WordApp.Documents.Open(filePath)
End If
On Error GoTo 0
EarlyExit:
Set GetWordDocument = ret
End Function