[kosmonavtom]

Цитата Iska:
Можно. Только не забудьте:
а) перед открытием проверить, существует ли этот файл в принципе, дабы не путаться в видах ошибок (коллега megaloman, впрочем, реализовал сию проверку зараз внутри функции);
б) вернуть стандартную обработку ошибок (On Error Goto 0) сразу после открытия файла и обработки ошибок. »
Спасибо за подсказки!

В общем вот что получилось:

Код:

' Сравнение нескольких пар документов запуск сравнения и сохранение результатов сравнений в один файл
Dim WshShell 'Объявляем переменные
Dim objFSO ' переменная для файлов
Dim strSourceFile ' Переменная для проверки есть ли файл с ответами
Dim ArrProverk ' Массив для имен файлов проверки
Dim ArrObrazec ' Массив для имен файлов образцов

' Нужно вприсать изменения (имена файлов, папок) в эту область:
ArrProverk = Array("Pro1.docx", "Pro2.docx", "Pro3.docx", "Pro4.docx") ' Запиши имена файлов которые нужно сравнить
ArrObrazec = Array("Obr1.docx", "Obr2.docx", "Obr3.docx", "Obr4.docx" ) ' Запиши имена файлов образцов (в том-же порядке)
pathObr = "C:\doc\" 'Запиши путь до файлов образцов
ItogoviRezultat = "Itogovi_Rezultat.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 & "Itogovi_Rezultat.docx") 'Сохраняем Документ
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 'Завершаем работу с доступом к файлам
WScript.Quit 0 'Закрываем WScript (тоже для доступак к файлам)
oDoc.Quit 0 ' закрываем Word

Проблема только в том, что после всего этого почему то Word не закрывается и висит в диспетчере задач не убитый висит! Пытался убить не получается. Что может быть не так? До введения обработки ошибок все нормально было.