VBS/WSH/JS

Iska · Отправлено: **22:20, 19-09-2017** | #2

daniil_im, «неверного указания пути» в этом коде быть не может, ибо путь к «Мои документы» задаётся функциями операционной системы. Имя файла указывается напрямую в коде. Что тут может быть «неверного»?!

Ну, хорошо. Предположим, мы настолько тупы, что указали в коде недопустимые символы в имени файла:

Код:

strDestFile = .BuildPath(WScript.CreateObject("WScript.Shell").SpecialFolders.Item("MyDocuments"), "текстовый ::: файл.txt")

Тогда так:

Скрытый текст

Код:

Option Explicit

Dim strDestFile

Dim objTS
Dim objFolder


With WScript.CreateObject("Scripting.FileSystemObject")
	strDestFile = .BuildPath(WScript.CreateObject("WScript.Shell").SpecialFolders.Item("MyDocuments"), "текстовый ::: файл.txt")
	
	If .DriveExists("C:") Then
		On Error Resume Next
		Set objTS = .CreateTextFile(strDestFile, True, True)
		
		If Err.Number <> 0 Then
			WScript.Echo "Can't create text file [" & strDestFile & "]." & vbCrLf & "Error: " & Err.Description
			
			Err.Clear
			On Error Goto 0
			
			WScript.Quit 2
		Else
			On Error Goto 0
		End If
		
		For Each objFolder In .GetFolder("C:\").SubFolders
			objTS.WriteLine ComposeAttributesString(objFolder.Attributes) & vbTab & objFolder.Name
		Next
		
		objTS.Close
		Set objTS = Nothing
	Else
		WScript.Echo "Drive C: not exists."
		WScript.Quit 1
	End If
End With

WScript.Quit 0

Function ComposeAttributesString(intAttributes)
	Dim strResult
	
	strResult = ""
	
	If intAttributes And 16   Then strResult = strResult & "D" Else strResult = strResult & " "
	If intAttributes And 2048 Then strResult = strResult & "C" Else strResult = strResult & " "
	If intAttributes And 1024 Then strResult = strResult & "L" Else strResult = strResult & " "
	If intAttributes And 32   Then strResult = strResult & "A" Else strResult = strResult & " "
	If intAttributes And 4    Then strResult = strResult & "S" Else strResult = strResult & " "
	If intAttributes And 2    Then strResult = strResult & "H" Else strResult = strResult & " "
	If intAttributes And 1    Then strResult = strResult & "R" Else strResult = strResult & " "
	
	ComposeAttributesString = strResult
End Function

kosmonavtom · Отправлено: **17:27, 13-01-2019** | #3

Цитата Iska:

Что тут может быть «неверного»?! »

Здравствуйте. У меня чуть, чуть другая проблема. В частности нужно обработать ошибку открытия файла Word.
Имеется скрипт vbs который сравнивает документы которые сдают обучающиеся.

Код:

Dim path, WshShell 'Объявляем переменные
Set WshShell = WScript.CreateObject("WScript.Shell") 'Создаем объект для пути
path = WshShell.CurrentDirectory & "\" 'Путь до скрипта и файлов
Set Application = CreateObject("Word.Application") ' Создаём объект с Word-ом
Application.Visible = False ' делаем НЕвидимым Word
Set Proveri = Application.Documents.Open(path & "doc1.docx", , False, , , , , , , , , True) 
Set Obrazec = Application.Documents.Open(path & "doc2.docx", , False, , , , , , , , , True) 
Set doc3 = Application.CompareDocuments(Proveri, Obrazec, , False, , , , , , , , , True)
doc3.SaveAs(path & "doc3.docx")
Application.Quit ' закрываем Word

Иногда обучающиеся получают на обработку файл формата rtf, но потом должны сохранить результат в docx и некоторые обучающиеся не зная, как это сделать просто вручную меняют расширение файла с rtf на docx. Естественно скрипт при открытии такого файла выдает мне ошибку. А нужно чтобы он условием If проверил это и написал об этой ошибке ученику в итоговый файл и продолжил работу. Подскажите пожалуйста каким обработчиком это можно сделать? Заранее спасибо.

Iska · Отправлено: **18:07, 13-01-2019** | #4

Цитата kosmonavtom:

и некоторые обучающиеся не зная, как это сделать просто вручную меняют расширение файла с rtf на docx. »

Информация о том, «как это сделать» должна присутствовать в инструкционной карте.

Цитата kosmonavtom:

Естественно скрипт при открытии такого файла выдает мне ошибку. »

Я не могу сэмулировать Вашу проблему: в моём Microsoft Word 2003 файл .rtf, будучи тупо переименован в расширение .docx, открывается программно без проблем, не генерируя при этом ошибки.

megaloman · Отправлено: **22:14, 13-01-2019** | #5

kosmonavtom, Не сильно изучал Ваши коды, однако, как идея, перед открытием документа с расширением .DOCX в WORD, проанализировать, не является ли он .RTF

Вот пример функции для такого анализа

Код:

File1 = "Z:\Box_In\doc1.docx"
File2 = "Z:\Box_In\doc2.docx"
File3 = "Z:\Box_In\doc2.docx"

File4 = "Z:\Box_In\docx.docx"
File5 = "Z:\Box_In\rtf.docx"
File6 = "Z:\Box_In\rtf.rtf"

MsgBox CStr(RTF(File1)) + vbCrLf + File1
MsgBox CStr(RTF(File2)) + vbCrLf + File2
MsgBox CStr(RTF(File3)) + vbCrLf + File3
MsgBox CStr(RTF(File4)) + vbCrLf + File4
MsgBox CStr(RTF(File5)) + vbCrLf + File5
    
'------------------------------------------
Function RTF(Fname)
' RTF=1 Файл .rtf
' RTF=0 Файл не .rtf
' RTF=-1 Файл не найден
' RTF=-2 Ошибка при открытии Файла
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FileExists(Fname) Then
        RTF = -1
        Exit Function
    End If

    On Error Resume Next

    Set iFile = FSO.OpenTextFile(Fname, 1, False)
    If Err.Number <> 0 Then
        RTF = -2
        On Error GoTo 0
        Exit Function
    End If
    AllTxt = iFile.ReadLine
    iFile.Close

    AllTxt = LCase(Mid(AllTxt, 1, 5))
    
    RTF = 1
    If Not AllTxt = "{\rtf" Then
        RTF = 0
    End If
    Set AllTxt = Nothing
End Function

kosmonavtom · Отправлено: **22:23, 13-01-2019** | #6

Цитата megaloman:

как идея, перед открытием документа с расширением .DOCX в WORD, проанализировать, не является ли он .RTF »

Спасибо за идею.

Но нашел решение вида:

Код:

On Error Resume Next 'Запускаем обработчик ошибок
Err.Clear 'Очищаем все ошибки
Set Proverk = Application.Documents.Open(path & "doc1.docx", , False, , , , , , , , , True)
If Err.Number = 0 Then ' Если ошибки нет то...
' Организуем проверку документа
Else
' Выводим в файл с результатом, что файл открывается с ошибкой
End If

Которое сработало. Т.е. просто проверять нет ли ошибок после открытия файла )) Думаю оно более универсально?

Iska · Отправлено: **23:58, 13-01-2019** | #7

Цитата kosmonavtom:

Код:

On Error Resume Next 'Запускаем обработчик ошибок 
Err.Clear 'Очищаем все ошибки

»

Err.Clear здесь лишнее — до On Error Resume Next все возникающие ошибки вызывают останов скрипта (и, возможно, вызов отладчика), а после On Error Resume Next никакой ошибки до Вашего Err.Clear возникнуть в принципе не может.

Цитата kosmonavtom:

Т.е. просто проверять нет ли ошибок после открытия файла )) Думаю оно более универсально? »

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

megaloman, можно и просто:

Код:

    AllTxt = iFile.Read(Len("{\rtf"))
    iFile.Close

    If Not StrComp(AllTxt, "{\rtf", vbTextCompare) = 0 Then
        RTF = 0
    End If

kosmonavtom · Отправлено: **00:23, 14-01-2019** | #8

Цитата 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 не закрывается и висит в диспетчере задач не убитый висит! Пытался убить не получается. Что может быть не так? До введения обработки ошибок все нормально было.

Iska · Отправлено: **02:17, 14-01-2019** | #9

Цитата kosmonavtom:

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

Это потому, что Вы завершаете исполнение скрипта:

Цитата kosmonavtom:

Код:

WScript.Quit 0 'Закрываем WScript (тоже для доступак к файлам)

»

до того, как закрываете открытый экземпляр Word'а:

Цитата kosmonavtom:

Код:

oDoc.Quit 0 ' закрываем Word

»

Цитата kosmonavtom:

До введения обработки ошибок все нормально было. »

«После» — не значит «вследствие»

.

kosmonavtom · Отправлено: **07:38, 14-01-2019** | #10

Цитата 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 (тоже для доступак к файлам)