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

Question

我正在使用 Excel VBA 打开现有的 Word 文档（基于在 Excel 工作表中输入的目录和文件名），然后复制并粘贴 table来自活动 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

Answer 1

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

最好使用用户窗体完成此操作，您可以将其配置为显示所有打开的 word 文档的列表。不过，我想你问的是

how can I avoid the error if the file identified by EinsuebPath 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

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

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

Answer 2

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

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

尝试

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

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

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

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

vba

excel

ms-word

copy-paste