Selection.InsertFile FileName:= "C:UsersFileName.Docx"行代码适用于 Word VBA,但不适用于 Excel VBA



我正在尝试使用书签插入多个Word文件。
以下搜索现有Word文件中的特定书签,并在现有Word文件中插入另一个Word文件的内容。
该代码的其余部分正常工作,除了线Selection.InsertFile FileName:=BookmarkValue
这条代码在Word VBA中起作用,但在Excel VBA中不起作用。

您能帮您弄清楚我错了吗?
为了您的方便,我已经在下面介绍了代码的简化版本。

Sub CreateWordDocuments3()
    Dim LastRow As Long
    Dim DocLoc, BookmarkName, BookmarkValue, FileName As String
    Dim WordDoc, WordApp As Object
    Dim WordContent As Word.Range
    With Sheet3
        'Open Word Template
        On Error Resume Next                     'If Word is already running
        Set WordApp = GetObject("Word.Application")
        If Err.Number <> 0 Then
            'Launch a new instance of Word
            Err.Clear
            'On Error GoTo Error_Handler
            Set WordApp = CreateObject("Word.Application")
            WordApp.Visible = True               'Make the application visible to the user
        End If
        DocLoc = "C:UsersDKCDesktopBasetemplate.docx"
        Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template          
        BookmarkName = .Cells(4, 2).Value        'BookmarkName is IndustryAnlysis in the word file (DocLoc)
        BookmarkValue = .Cells(4, 3).Value       'BookmarkValue is link to the word file to be inserted = "C:UsersDKCDesktopIndustry Analysis.docx"
        WordDoc.Bookmarks(BookmarkName).Select
        Selection.InsertFile FileName:=BookmarkValue ' Line code working in word VBA but not in excel VBA
        FileName = ThisWorkbook.Path & "" & "NewDoc" & ".docx"
        WordDoc.SaveAs FileName
        WordApp.Quit
    End With
End Sub

在这篇文章的帮助下如何通过excel vba来弄清楚它 - 或更尤其是@timwilliams在第二个答案的底部发表的评论。

Selection的问题是它将引用Excel。我试图将其链接到Word文档,但这是该应用程序的属性:

每个文档窗口窗格只能只有一个选择对象,并且 整个应用程序中只有一个选择对象可以活跃。

选择对象

我还将createword拉出到一个单独的功能。

Public Sub CreateWordDoc()
    Dim oWrd As Object, oWrdDoc As Object
    Dim BkMkName As String, BkMkValue As String
    Const docloc As String = "C:UsersDKCDesktopBasetemplate.docx"
    Set oWrd = CreateWord
    Set oWrdDoc = oWrd.documents.Open(docloc, False)
    With Sheet3
        BkMkName = .Cells(4, 2)
        BkMkValue = .Cells(4, 3)
    End With
    oWrdDoc.Bookmarks(BkMkName).Select
    oWrd.Selection.InsertFile Filename:=BkMkValue
End Sub
Public Function CreateWord(Optional bVisible As Boolean = True) As Object
    Dim oTempWD As Object
    On Error Resume Next
    Set oTempWD = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTempWD = CreateObject("Word.Application")
    End If
    oTempWD.Visible = bVisible
    Set CreateWord = oTempWD
    On Error GoTo 0
    Exit Function
ERROR_HANDLER:
        MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateWord."
            Err.Clear
End Function  

编辑 -
因此,如果您不想使用我发布的代码,您的代码应该通过更改

来工作
Selection.InsertFile FileName:=BookmarkValue  

to

WordApp.Selection.InsertFile FileName:=BookmarkValue

最新更新