[kosmonavtom]

Цитата Iska:
Это потому, что Вы завершаете исполнение скрипта: до того, как закрываете открытый экземпляр Word'а:»
Да! Спасибо!!! Поменял местами и работает. Очень странно правда, т.к. до этого без обработчика ошибок и так работало!


Еще нужно было подставить ItogoviRezultat в строку 30 примерно:

Код:

ItogRezult.SaveAs(pathPro & ItogoviRezultat) 'Сохраняем Документ

В итоге вот так записана рабочая версия на практике:

Код:

' Литература: Условие http://forum.oszone.net/post-2782627.html
' Сравнение нескольких пар документов запуск сравнения и сохранение результатов сравнений в один файл
Dim WshShell 'Объявляем переменные
Dim objFSO ' переменная для файлов
Dim strSourceFile ' Переменная для проверки есть ли файл с ответами
Dim ArrProverk ' Массив для имен файлов проверки
Dim ArrObrazec ' Массив для имен файлов образцов

' Нужно вприсать изменения (имена файлов, папок) в эту область:
ArrProverk = Array(_
"31_Правила_ввода.docx",_
"31_Стих.docx",_
"31_Рецензия на пословицы.docx",_
"31_Объявление.docx") ' Запиши имена файлов которые нужно сравнить
ArrObrazec = Array(_
"ОТВЕТ 31_Правила_ввода.docx",_
"ОТВЕТ 31_Стих.docx",_
"ОТВЕТ 31_Рецензия на пословицы.docx",_
"ОТВЕТ 31_Объявление.docx") ' Запиши имена файлов образцов (в том-же порядке)
pathObr = "D:\Параметры страницы Редактирование текста\" 'Запиши путь до файлов образцов
ItogoviRezultat = "31 ПРОВЕРКА.docx" 'Запиши имя файла для результата проверки

Set WshShell = WScript.CreateObject("WScript.Shell") 'Создаем объект для пути
pathPro = WshShell.CurrentDirectory & "\" 'Определяем путь до скрипта и файлов проверки (там куда нужно записать этот скрипт и запускать)
Set oDoc = CreateObject("Word.Application") ' Создаём объект с Word-ом
oDoc.Visible = False ' делаем НЕвидимым Word
Const wdStory = 6 ' Константа для добавления новой страницы
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 'Создаем объект проверки наличия файла
Set ItogRezult = oDoc.Documents.Add() ' Добавляем документ Для записи итоговых результатов
ItogRezult.SaveAs(pathPro & ItogoviRezultat) 'Сохраняем Документ
ItogRezult.Close 'закрываем Документ
n=0 'Переменная для цикла (перебор элементов массива т.е. всех файлов)

FOR Each Item in ArrObrazec 'Перебираем все элементы которые только есть в массиве Образцов
    strSourceFile = pathPro & ArrProverk(n) ' Записываем новый файл в переменную для проверки
        Set ItogRezult = oDoc.Documents.Open(pathPro & ItogoviRezultat) ' Добавляем документ Для записи итоговых результатов
        Set oSelectionPlace = oDoc.Selection ' Получаем доступ к выделенной области
        oSelectionPlace.EndKey wdStory ' Проверяем конец документа (Литература: https://stackoverrun.com/ru/q/8591117)
        oSelectionPlace.InsertBreak  ' Добавляем новую страницу в конце документа
        oSelectionPlace.TypeText "Результат проверки файла: " & strSourceFile ' Вводим текст (заголовок) в начале новой страницы
        oSelectionPlace.Style = "Заголовок 1"
        oSelectionPlace.TypeParagraph() ' Добавляем новый абзац
    If objFSO.FileExists(strSourceFile) Then
        '[если файл существует то выполнить эти команды:]
        On Error Resume Next 'Запускаем обработчик ошибок
        Set Proverk = oDoc.Documents.Open(strSourceFile, , False, , , , , , , , , True) 
        If Err.Number = 0 Then 'Если ошибки нет то
            On Error Goto 0 ' Отключение обработчика ошибок см. http://www.cyberforum.ru/vba/thread735309.html
            Set Obrazec = oDoc.Documents.Open(pathObr & ArrObrazec(n), , False, , , , , , , , , True) 
            Set PromRezult = oDoc.CompareDocuments(Proverk, Obrazec, , False, , , , , , , , , True) 'Записываем промежуточный результат сравнения
            ' Закрываем проверенные документы 
            Obrazec.Close
            Proverk.Close
            ' Переписываем результат из промежуточного файла проверки в итоговый
            PromRezult.Range.Copy 'Копируем из промежуточного все в буфер обмена
            PromRezult.Close False ' Закрыть промежуточный документ без сохранения (False)
            oSelectionPlace.Range.Paste ' Вставляем все из буфера обмена в итог
        Else ' Если ошибка есть, то пишем о ней ученику в итоговый файл
            On Error Goto 0 ' Отключение обработчика ошибок см. http://www.cyberforum.ru/vba/thread735309.html
            oSelectionPlace.Font.Size = "16" ' Указываем размер шрифта
            oSelectionPlace.Font.Color = RGB(255, 00, 00) ' Устанавливаем цвет текста
            oSelectionPlace.TypeText "ОШИБКА! Файл не открывается! Скорее всего, файл был сохранен с неправильным расширением, или расширение было заменено вручную, а не при сохранении Word в окне Сохранить как... пункт: Тип файла." ' В файле проверке Сообщаем ученику об ошибке с самим файлом                
        End If
    Else
        '[если файл не найден то выполнить эти команды:]
        oSelectionPlace.Font.Size = "16" ' Указываем размер шрифта
        oSelectionPlace.Font.Color = RGB(255, 00, 00) ' Устанавливаем цвет текста
        oSelectionPlace.TypeText "Файл отсутствует! Значит задание не выполнено или файл сохранен в другом месте или имя файла написано неправильно." ' В файле проверке Сообщаем ученику об ошибке с самим файлом        
    End If
    ItogRezult.Save() 'Сохраняем результат проверки
    ItogRezult.Close ' Закрываем файл с результатом проверки
    n=n+1 ' Увеличиваем перменную проверки пар документов (т.е. переходим к следующей паре)
NEXT

Set ItogRezult = oDoc.Documents.Open(pathPro & ItogoviRezultat) ' Добавляем документ Для записи итоговых результатов
Set oSelectionPlace = oDoc.Selection ' Получаем доступ к выделенной области
oSelectionPlace.Paragraphs.First.Range.Delete 'Удаляем первую (пустую) страницу
ItogRezult.Save() 'Сохраняем результат проверки
ItogRezult.Close ' Закрываем файл с результатом проверки
Set objFSO = Nothing 'Завершаем работу с доступом к файлам
oDoc.Quit 0 ' закрываем Word
WScript.Quit 0 'Закрываем WScript (тоже для доступак к файлам)