mutilpleをマージするWord Docs

Question

複数の小さなdocx（またはrtf）を1つのdocxにまとめる簡単なコードを開発しようとしています。

文書作成には、以下に基づくべきである：
1.私は、列AにB列の小さなドキュメント
2の名前のリストを持っている（はい/いいえ）
EX 2つのエントリの一つであります：

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

3. iは既に 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 

のeがこのコードの問題は、それが一時ドキュメントが開か殺すことはありませんので、私は10のWINWORDプロセスなしMSWordのウィンドウで終わるでしょマージする10のドキュメントを持っているということです。 には、この問題を解決する方法があります。 私はすべての小さなドキュメントを.rtfに変換すると、ファイルを開く必要なくファイルを解析できます。

すべてのヘルプははるかに

Answer 1

重大なトラブルシューティングの後、私はついにそれを動作させました。ここでは以下のコードです。

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：おかげでシリルは先端のために、のは、複数のWord文書を組み合わせたようなものを試してみましょう鉱山

Answer 2

を理解されるであろう、私はこれは私が説明しますとまったく同じように動作しない場合は、テンプレートのコレクションなので、私の謝罪から文書を取り込むために使用するユーザーフォームから、このコードを引っ張っています：

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文をすべて取り出しました。

可能性は、上記のコードを取って、あなたのColumn BセルにComboBox1.Value（yes/no entries）を定義させることです。 Selection.InsertFile FileName：=列Aの隣接するセルに定義されている位置に直接移動します。これは、最後の行のループを利用する動的参照である必要があります。

私が行っていないことは、通常、コンテンツを操作して、コレクション内のいくつかのテンプレートの標準であるセクションを削除する必要があるため、マージされたドキュメントを自動保存することです。

うまくいけば、それは助けて、カリム！ Word文書（.docまたは.docx）だけで作業するときは、タスクマネージャにプロセスが表示されますが、挿入が完了すると消えて、開いている文書のWordプロセスが1つ残ってしまいます。

Answer 3

の痛みを解決するための鍵となりました。それぞれのすべての内容をコピーし、すべてを1つの統合された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