Слияние информации из нескольких файлов word в один файл с помощью макроса

[solpaev]

Здравствуйте уважаемые "жильцы" форума, подскажите, как сделать такую вещь.
Макрос работает из файла excel, программа представляет собой код который из каталога выбирает позиции и создает из них предложение. Для сопровождения этого предложения необходимо создать технический лист. Задумка такова - в отдельных файлах word уже лежит информация по каждой позиции, код должен:
1. Создать файл word (например Технический_лист.doc) и открыть его
2. Открыть файл word с указанным именем (например "Кран1.doc) скопировать из него всю информацию и вставить её в "Технический_лист.doc", закрыть файл "Кран1.doc
3. Открыть файл word с указанным именем (например "Кран2.doc) скопировать из него всю информацию и вставить её в "Технический_лист.doc" , закрыть файл "Кран2.doc
4...И т.д. циклически для каждого пункта предложения.
5. Сохранить и закрыть файл Технический_лист.doc

Вот я пытался танцевать танцы с бубном, но ничего не получается:

Макрос

Sub SozdatTechSheet(CreatedFileNameTech As String)
Dim OpenWord, NewWordFile, CatWordFile, OSel, OselNew As Object
Dim CatalogDir, CatalogOborudovanie, CatalogMateriali, LookedForFileName, InDex As String
Dim i As Byte
Dim metka As Integer
Dim arr() As Variant

CatalogDir = ThisWorkbook.Path & "\" & "Каталог"
CatalogOborudovanie = CatalogDir & "\" & "Оборудование"
CatalogMateriali = CatalogDir & "\" & "Материалы"

Set OpenWord = CreateObject("Word.Application")
Set NewWordFile = OpenWord.documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0, Visible:=False)
NewWordFile.SaveAs2 FileName:=CreatedFileNameTech, FileFormat:=wdFormatXMLDocument, LockComments:=False

metka = 0
metka = Predlozhenie.PoiskMetki(metka)

arr = Predlozhenija.Range("B" & metka & ":B100").Value
   
    Do While arr(i + 1, 1) = "Metka" 'Цикл выполняется до тех пор пока значение i совпадает с меткой
        InDex = Predlozhenija.Range("C" & metka + i)
        InDex = CatalogOborudovanie & "\" & InDex & FolderNameRazd & "*.docx"
        If Dir(InDex) <> "" Then
        LookedForFileName = CatalogOborudovanie & "\" & Dir(InDex)
            Set CatWordFile = OpenWord.documents.Open(LookedForFileName)
            Set OSel = CatWordFile.Range()
            OSel.Copy
            Set OselNew = NewWordFile.Range()
            OselNew.PasteAndFormat (wdFormatOriginalFormatting)
            OselNew.InsertBreak Type:=wdPageBreak
            CatWordFile.Close savechanges:=wdDoNotSaveChanges
        End If
        i = i + 1
       
    Loop

NewWordFile.Close savechanges:=wdSaveChanges, OriginalFormat:=wdOriginalDocumentFormat


End Sub

[свернуть]

Заранее благодарен за помощь.

[Администратор]

Не ответ на ваш вопрос, просто увидел неточность у вас.
В VBA есть особенность - нужно указывать тип данных для каждой переменной, а не один раз в конце.
Если не указывать для переменной тип данных, то переменная будет иметь тип данных "Variant".

Правильно так, если у всех переменных должен быть тип данных "Object":
Dim OpenWord As Object, NewWordFile As Object, CatWordFile As Object, OSel, OselNew As Object

[Администратор]

Приложите эксель-файл, который участвует в этом макросе.
В файле можете оставить только те данные, которые участвуют в макросе.

[solpaev]

Вот файл excel и структура каталогов и файлов.

[вложение удалено администратором]

[Администратор]

Это не ответ на вопрос, а замечание. Хотя и это тоже вызовет ошибку.
Экселю не известны вордовские константы:
savechanges:=wdDoNotSaveChanges

Правильно так:
savechanges:=0

[solpaev]

Спасибо за замечания насчет констант я даже как-то не подумал.

[Администратор]

Сделал, смотрите файл.

[вложение удалено администратором]

[solpaev]

Спасибо большое всё работает. Огромное спасибо Администратору форума, вы значительно упростили мне жизнь (и моему менеджеру в том числе).