Question

我正在尝试开发一个简单的代码，它将多个小docx（或rtf）组合到一个docx中。

文件创建应基于以下内容：
1.我在A栏中列出了小文档的名称 2.在B列中是2个条目之一（是/否）
例如：

    A     B
   doc1  yes      
   doc2  no    
   doc3  yes    
   doc4  yes     
   doc5  no

3。我已经在工作表的单元格中提供了小文档的位置 4.还提供了放置新（合并）文档的地方

下面的

代码示例

Application.ScreenUpdating = False
strRandom = Replace(Replace(Replace(Now, ":", ""), "/", ""), " ", "")
MergeFileName = "Merger" & strRandom & ".doc"
MergeFolder = mainworkbook.Sheets("Main").Range("L10").Value

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
Set objSelection = objWord.Selection
'objSelection.TypeText ("Saving this file after this text")
objDoc.SaveAs (MergeFolder & MergeFileName)

For i = 1 To NoOfFiles
    If Range("B" & i).Value = "Yes" Then
        Set objTempWord = CreateObject("Word.Application")
        Set tempDoc = objWord.Documents.Open(Folderpath & "\" & Range("A" & i).Value)
        'Set wb = Documents.Open(MyPath & "\" & MyName)
        Set objTempSelection = objTempWord.Selection
        'objTempSelection.WholeStory
        'Selection.Copy
        tempDoc.Range.Select
        tempDoc.Range.Copy
        'Windows(1).Activate
        'Selection.EndKey Unit:=wdLine
        'objSelection.TypeParagraph
        objSelection.PasteSpecial xlPasteAll
        .InsertBreak wdPageBreak
        tempDoc.Close
    End If
Next

objDoc.Save
Application.ScreenUpdating = True
mainworkbook.Sheets("Main").Activate
MsgBox "Completed...Merge File is saved at " & MergeFolder & MergeFileName
FetchFileClicked = False
End Sub

这个代码的问题是它永远不会杀死打开的临时文档，所以我有10个文档要合并，最终会有10个WINWORD进程，没有MSWord窗口。有没有办法解决这个问题。我听说如果我将所有小文档转换为.rtf我可以解析文件而无需打开它。

任何帮助将不胜感激

Answer 1

我从用户表单中提取此代码，用于填充模板集合中的文档，所以如果这不能完全按照我的描述工作，我很抱歉：

Sub Insert_File_From_Location()

CreateObject (Word.Application.Documents.Add)

If ComboBox1.Value = "blah" Then
        Selection.InsertFile FileName:="C:\blah.docx"
    Else:
    End If

End Sub

我取出了所有其他if语句，使其看起来更简单。

一种可能性是，采用上面的代码并操作让你的B列单元格定义ComboBox1.Value（是/否条目）。然后，您将具有Selection.InsertFile FileName：=直接到列A中相邻单元格中定义的位置。这将需要使用循环通过最后一行的动态引用。

我没有进行的是自动保存合并文档，因为我必须通常操作内容并删除我的集合中某些模板的标准部分。

希望这有帮助，卡里姆！使用Word文档（.doc或.docx）时，我的任务管理器中会显示进程，但是在插入完成后它们会消失，为打开的文档留下一个Word进程。

Answer 2

经过一些严肃的故障排除后，我终于开始工作了，下面是代码。

Application.ScreenUpdating = False
strRandom = Replace(Replace(Replace(Now, ":", ""), "/", ""), " ", "")
MergeFileName = "Merger" & strRandom & ".doc"
MergeFolder = mainworkbook.Sheets("Main").Range("L10").Value

Set objWord = CreateObject("Word.Application")
Set appWord = GetObject(, "Word.Application")
Set objDoc = objWord.Documents.Add

objWord.Visible = True

Set objSelection = objWord.Selection

objDoc.SaveAs (MergeFolder & MergeFileName)

For i = 1 To NoOfFiles
    If Range("B" & i).Value = "Yes" Then
        myName = (Folderpath & "\" & Range("A" & i).Value)

        With appWord.Selection
        .InsertFile Filename:=myName
        End With

        With objWord.Selection
        .Collapse Direction:=wdCollapseEnd
        .InsertBreak Type:=7
        End With
    End If
Next

objDoc.Save
Application.ScreenUpdating = True
mainworkbook.Sheets("Main").Activate
MsgBox "Completed...Merge File is saved at " & MergeFolder & MergeFileName

PS：感谢西里尔提示，这是解决我痛苦的关键

Answer 3

让我们尝试组合多个Word文档;您需要复制每个内容的所有内容，并将所有内容粘贴到一个合并的Word文档中。这可能需要很长时间，特别是如果文件夹中有许多文件。只需运行下面的脚本，代码就会为您完成所有工作。

Sub MergeAllWordDocs1()
    Dim i As Long
    Dim MyName As String, MyPath As String
    Application.ScreenUpdating = False
    Documents.Add
    MyPath = "C:\Users\your_path_here\" ' <= change this as necessary
    MyName = Dir$(MyPath & "*.do*") ' not *.* if you just want doc files
    Do While MyName <> ""
        If InStr(MyName, "~") = 0 Then
            Selection.InsertFile _
    FileName:="""" & MyPath & MyName & """",
            ConfirmConversions:=False, Link:=False,
            Attachment:=False
    Selection.InsertBreak Type:=wdPageBreak
  End If
        MyName = Dir() ' gets the next doc file in the directory
    Loop
End Sub

合并多个Word文档

3 个答案: