Вставка текста в несколько файлов

Sub Insert()
On Error Resume Next
Dim picker As New FilePicker
Dim wordApp As Application
Dim wordDocument As Word.Document
 
picker.pickFile "Word files", Array("*.doc;*.docx;*.docm")
If UBound(picker.items) < 0 Then: Exit Sub
 
 
Set wordApp = New Application
wordApp.Visible = True
 
Application.DisplayAlerts = wdAlertsNone
wordApp.DisplayAlerts = wdAlertsNone
 
For Each FileName In picker.items
Set wordDocument = wordApp.Documents.Open(FileName)
With wordDocument
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:="=====+++++======"
 
End With
wordDocument.Close SaveChanges:=True
Next
wordApp.Quit
End Sub

Public Sub pickFile(Optional ftype = "Text file", Optional extensions = "", Optional multiselect = True)
    Dim filePick As FileDialog
    Set filePick = Nothing
    Set filePick = Application.FileDialog(msoFileDialogFilePicker)
    filePick.Filters.Clear
    For Each ext In extensions
        filePick.Filters.Add ftype, ext
    Next
    filePick.AllowMultiSelect = multiselect
    filePick.Show
    
    selected = False
    If filePick.SelectedItems.Count = 0 Then: Exit Sub
    selected = True
    ReDim items(filePick.SelectedItems.Count - 1)
    For I = 0 To filePick.SelectedItems.Count - 1
        items(I) = filePick.SelectedItems(I + 1)
    Next
End Sub

Sub Insert()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Word files", "*.doc;*.docx;*.docm"
        If Not .Show Then Exit Sub
        Application.DisplayAlerts = wdAlertsNone
        Application.ScreenUpdating = False
        For Each FileName In .SelectedItems
            With Documents.Open(FileName)
                .Range.InsertAfter "=====+++++======"
                .Close True
            End With
        Next
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = wdAlertsAll
End Sub

.Range.InsertAfter Space(КоличествоПробелов)

  Dim pageRange As Range, i&
    ' определение начала требуемой страницы - 5
    Set pageRange = ActiveDocument.Range.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=5)
    ' позиция первого символа следующей страницы
    i = pageRange.GoToNext(wdGoToPage).End
    ' определение диаппазона страницы
    If pageRange.Start = i Then
        ' последняя страница
        pageRange.End = ActiveDocument.Range.End ' диаппазон до конца документа
    Else
        ' существует страница после
        pageRange.End = i - 1   ' диаппазон до начала следующей страницы
    End If
    
    pageRange.ParagraphFormat.LineSpacing = 14 ' устанавливаем межстрочный интервал
    ' удаляем надписи
    For i = 1 To pageRange.ShapeRange.Count
        pageRange.ShapeRange(1).Delete
    Next

Выделяем 5-ю строку
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=5
Set sPages = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=5
sPages.End = Selection.Bookmarks("\Page").Range.End
sPages.Select
 
For Each sh In sPages.ShapeRange
   sh.Delete
Next sh

 Set spages = ActiveDocument.Range.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=3)
 spages.End = spages.Bookmarks("\Page").Range.End
 ' spages.Select
 
 For i = 1 To spages.ShapeRange.Count
    spages.ShapeRange(1).Delete
 Next

Set Note = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, 280, 18)
 
'Selection.InsertFile FileName:="table.docx"
With Note
.Line.Visible = msoFalse
'.InsertFile FileName:="table.docx"
 
End With

    Set Note = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, X, Y, 280, 18)
    Note.TextFrame.TextRange.InsertFile "E:\тест.docx"
    ' след.стр. для автободбора размера под текст
    Note.TextFrame.AutoSize = True