将多个Word文档复制到一个新的Word文档中

问题描述

我是VBA的新手，想寻求帮助。

我有一个B3：B40范围内e​​xcel中的Word文档列表。我想在列表中复制文档并粘贴到新文档中，而无需更改页面格式。

我已经尝试了下面的代码，它给了我“运行时错误13”。有人可以帮助解决这种情况吗？ 预先感谢您的帮助。

Application.ScreenUpdating=false

set objword = createobject("Word.Application")
set objdoc = objword.Documents.Add
objword.visible = true

set objselection = objword.Selection
Folderpath = "C:\desktop"  'where I save the word document that would be combined

set objtempword = createobject("Word.Application")
set tempdoc = objword.documents.open (Folderpath & "\" & Sheet1.Range ("B3:B40")
set objtempselection = objtempword.selection
tempdoc.range.select
tempdoc.range.copy
objselection.typeparagraph
objselection.paste
tempdoc.close

 

解决方法

我认为这可能对您有用。缺少的是每个文件（范围中的单元格）的工作周期。

Option Explicit

Sub JoinDocs()
    Application.ScreenUpdating = False
    Dim objword As Object,objdoc As Object,objselection   As Object
    Set objword = CreateObject("Word.Application")
    Set objdoc = objword.Documents.Add
    objword.Visible = True
    Dim Folderpath  As String
    Set objselection = objword.Selection
    Folderpath = "C:\desktop\"  'where I save the word document that would be combined
    Dim vDoc As Variant
    Dim objtempword As Object,tempdoc As Object,objtempselection As Object
    Set objtempword = CreateObject("Word.Application")
    For Each vDoc In Sheet1.Range("B3:B40").Value
        Set tempdoc = objword.Documents.Open(Folderpath & vDoc)
        Set objtempselection = objtempword.Selection
        tempdoc.Range.Select
        tempdoc.Range.Copy
        objselection.TypeParagraph
        objselection.Paste
        tempdoc.Close
    Next vDoc
End Sub