Dim i, FileList, objSelection, objDoc, objWord, objWMIService
Const strComputer = "."
Const wdStory = 6

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objWord = CreateObject("Word.Application")

objWord.Visible = False

Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

' получаем список всех doc-файлов в каталоге "C:\Windows\Temp\Каталог с документами"
Set FileList = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='C:\Windows\Temp\Каталог с документами'} Where ResultClass = CIM_DataFile")

' в цикле вставляем каждый найденный файл в документ с нового раздела
i = 0
For Each objFile In FileList
    objSelection.InsertFile(objFile.Name)

    i = i + 1
    If i < FileList.Count Then
      objSelection.EndKey wdStory
      objSelection.InsertBreak
    End If
Next

objDoc.SaveAs("C:\Windows\Temp\test.doc")
objWord.Quit

Set FileList = nothing
Set objSelection = nothing
Set objDoc = nothing
Set objWord = nothing
Set objWMIService = nothing