Макрос-собрать в 1 файл 100 файлов из 1-й папки: сначала 1.docx потом 2.docx ...

[Бахтиёр]

Добрый день.
В папке "Фон" на диске D есть 100 файлов .docx
Их названия: 1.docx, 2.docx, 3.docx, ... 99.docx, 100.docx
В каждом файле по одной странице, максимум два.

Нужен макрос, который бы собрал в один файл все 100 файлов: он должен сначала взять 1.docx, потом 2.docx, потом 3.docx и так далее.
Заранее спасибо.

[Дмитрий Щербаков(The_Prist)]

Код когда-то писался мной для .rtf, но для docx тоже должен подойти:

Код: (vb)

Sub MergeFiles()
    Dim avFiles, lr As Long
    Dim docAct As Document, docNow As Document

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "*.rtf"
        .AllowMultiSelect = True
        If .Show = False Then Exit Sub
        Set docAct = ActiveDocument
        For lr = 1 To .SelectedItems.Count
            Set docNow = Documents.Open(.SelectedItems(lr))
            docNow.Range.Copy
            docAct.Range(docAct.Range.End - 1).Paste
            docAct.Range(docAct.Range.End - 1).InsertBreak Type:=0
            docNow.Close 0
        Next lr
    End With
End Sub

Код должен располагаться в документе Word.

[Бахтиёр]

Дмитрий, спасибо.
Нашёл ваш код на другом форуме, хотел написать, не успел, вы уже написали.
Потестил, всё нормально.
Думал может мне придётся 1 переименовать на 001, 2 на 002 и т.д. , ан-нет код и так работает как нужно при названии файлов: 1.docx, ... 9.docx, 10.docx, ... 100.docx.

Спасибо.