首页 文章

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

提问于
浏览 次
0

我正在使用Excel VBA打开现有的Word文档（基于Excel工作表中输入的目录和文件名），然后从活动的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
excel vba excel-vba ms-word copy-paste

2 回答

  • 0

    您正在引用正确的Word文档，但您没有使用该引用 . 代替

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

    尝试

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

    请注意，这未经过测试 . 请评论这是否有效 .

    回复于
  • 0

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

    使用UserForm可以最好地完成此操作，您可以将其配置为显示所有打开的word文档的列表 . 但是，我想你要问的是

    如果EinsuebPath识别的文件已经打开，我该如何避免错误？

    简单 . 检查文档是否已打开！

    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
    回复于

相关问题