Word Macro that combines files, need to insert breaks & titles

Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Const strFolder = "C:\Book\Chapters\" 'change to suit
Set MainDoc = Documents.Add
strFile = Dir$(strFolder & "*.rtf") ' can change to .docx
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
End Sub

Click to expand...

Sub MergeDocs()
Dim rng As Range
Dim FinalEvidence As Document
Dim strFile As String
'Dim OutPut_file_name As String
Const strFolder = "C:\Test\" 'change to any dir which you wanna use
Set FinalEvidence = Documents.Add
strFile = Dir$(strFolder & "*.rtf")
Do Until strFile = ""
Set rng = FinalEvidence.Range
rng.Collapse wdCollapseEnd
rng.InsertFile strFolder & strFile
strFile = Dir$()
Selection.InsertBreak Type:=wdPageBreak
Loop
' OutPut_file_name = "FinalEvidence.doc"
End Sub

Click to expand...

Sub dofiles()


Set fs = Application.FileSearch
Dim newbook, curbook, MyCount, myrange
With fs
.lookin = "c:\"
'LookIn should be changed to the location you want to use
.SearchSubFolders = True 'assuming you DO want to search subfolders

.FileName = "*.doc"
'if you are looking for other than DOC files, alter the line above - so probably RTF in your case
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count

Documents.Open FileName:=.FoundFiles(i)
Selection.WholeStory
Selection.Copy
ActiveWindow.Close
Selection.EndKey Unit:=wdStory

Selection.InsertBreak type:=wdSectionBreakNextPage
Selection.PasteAndFormat (wdPasteDefault)


Next i
Else
MsgBox "There were no files found."
End If
End With



End Sub

Click to expand...