MS Word - Сводный документ MS Word из нескольких (Вставка в заданный шаблон)

По материалам: http://www.cyberforum.ru/ms-access/thread494165.html

Берём несколько документов Word (в примере максимум 5) и вставляем их содержимое в один.
Проще говоря: обьединение нескольких документов в один.

Код из примера:

Private Sub MakeReport()
'Создание общего документа по указанным файлам ...
'--------------------------------------------------------------------------
Dim sFilePath As String
Dim s As String
Dim objNewDoc As Object
Dim i%, str$, iRet%
'
'--------------------------------------------------------------------------
On Error GoTo MakeReport_Err
    For i = 1 To 5  'пока проверка
        str = "txtDocPath0" & i
        If IsNull(Me.Controls(str).Value) = False Then
            s = Me.Controls(str).Value
            If Dir(s, vbNormal) <> "" Then
                iRet = iRet + 1
            Else
                Me.Controls(str).Value = Null
            End If
        End If
    Next i
    
    If iRet = 0 Then
        MsgBox "Файлы не указаны!" & vbCrLf & _
            "Укажите сначала включаемые файлы ... ", vbExclamation, "Нет файлов"
        Exit Sub
    End If

    DoCmd.Hourglass True 'Показать часики
'Поехали!
        
    Set objWord = CreateObject("Word.Application")
    'objWord.Visible = False
    sFilePath = CurrentProject.Path & "\Шаблон_01.dotx"
        
'Открываем НОВЫЙ документ сформированный по заданному шаблону
    Set objNewDoc = objWord.Documents.Add(sFilePath)
           
     For i = 1 To 5  '
        str = "txtDocPath0" & i
        If IsNull(Me.Controls(str).Value) = False Then
            iRet = iRet + 1
            s = Me.Controls(str).Value
            GetFileDataByPath s, objNewDoc
            'Debug.Print s
        End If
    Next i
               
    objWord.Visible = True
    objWord.Activate

    'objWord.Quit

MakeReport_End:
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    Set objNewDoc = Nothing
    Set objWord = Nothing
    Exit Sub

MakeReport_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: MakeReport in module: Form_frmDocuments", vbCritical, "Error in Application"
    Err.Clear
    Resume MakeReport_End
End Sub

Обработка одного документа:

Private Sub GetFileDataByPath(sPath As String, owNewDoc As Object)
'Обработка одного документа: Копирование - Вставка в основной
'--------------------------------------------------------------------
Dim objDoc As Object
'--------------------------------------------------------------------
    If Dir(sPath, vbNormal) = "" Then Exit Sub
    
'Метод Documents.Open (Word)
'https://msdn.microsoft.com/ru-ru/vba/word-vba/articles/documents-open-method-word
    Set objDoc = objWord.Documents.Open(sPath, False, True) 'Открываем документ
   
    objDoc.Range.Select 'Select all text in a document
    objDoc.Range.Copy   'Copy the selected text to the clipboard

    'Selection в конец текста!
    With owNewDoc.Content
        .Collapse 0 'wdCollapseEnd=0
        .Select
        
        .Text = "Содержимое документа: " & sPath & vbCrLf  'vbCrLf &
        .Collapse 0 'wdCollapseEnd=0
        .Select
        
        'Debug.Print "Содержимое документа: " & sPath
        .Paste 'Вставка
    End With

   On Error Resume Next
   objDoc.Close 'acSaveNo
End Sub

MSA-2007 ( 463 kB) Пример