Vba 如果Word已打开，则打开并粘贴到现有Word文档错误中

我正在使用Excel VBA根据Excel工作表中输入的目录和文件名打开现有Word文档，然后从active Excel工作簿复制并粘贴一个表，让Word文档保持打开状态，以便用户手动排列

如果Word尚未打开，下面的代码可以正常工作，但如果Word已打开，它将打开文档，但当它粘贴文档时，会跳转到“未找到文档”的错误处理程序

如何从多个打开的Word文档中选择所需的Word文档，然后粘贴到其中

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

如何从多个打开的word文档中选择所需的word文档以粘贴到

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

这最好使用UserForm来完成，您可以将其配置为显示所有打开的word文档的列表。然而，我想你问的是

如果EinsuePath标识的文件已打开，如何避免该错误

简单。检查文档是否已打开

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

假设文件已打开，我将使用自定义函数首次尝试访问该文件。如果该语句出错，则它将尝试打开该文档

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

---

您正在引用正确的word文档，但未使用引用。而不是

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

试一试

---

请注意，这没有经过测试。请评论这是否有效。

我最初的问题发生在任何Word文档打开时。英国人的回答解决了这个问题。但现在我可以过去，我可以看到，我需要你的建议检查，看看这个实际的表已经打开，所以我也需要你的编码建议。你救了我第二个问题。也谢谢你！这种编码给了我以下信息：如果Word未打开或使用balnk Word文档打开，它将打开请求的文档，然后转到错误消息“document not found”，而不粘贴。如果它已经打开了，我会收到一条消息说我可以打开一个只读版本。嗯，我看到我的代码中有一个输入错误，所以也许可以尝试修改GetWordDocument的函数。如果仍然出现错误，则需要告知错误消息和错误发生的行。