roboforum.ru

dccharacter писал(а):принтер с мониторингом папок
роутер+принтер -> настроить мониторинг папки

dccharacter писал(а):а что за принтер-то?

Код: Выделить всё • Развернуть

'========================================================================== 
'Печать документа с помощью MS Word 
'Параметры: 
'{Файл} [{Принтер}|"" [{Кодовая страница}|"" [{Количество копий}]]] 
'Пример параметров: 
'C:\Temp\Test.txt \\Host\HostPrinter 1251 
'Для использования значений по умолчанию принтера или кодовой страницы 
'  можно указать двойные кавычки ("") 
'Пример параметров: 
'C:\Temp\Text_default.txt 
'C:\Temp\Text_dos.txt "" 866 
'C:\Temp\Text_3_copies.txt "" "" 3 
'========================================================================== 
Option Explicit 
'================= Изменяемые параметры =================================== 
Const TimeLimit = 30      'Время ожидания окончания печати в сек. 
Const Margin    = 1.5     'Поля в см 
Const Admin     = "admin" 'Имя компьютера сис. админ-а 
Const ShowMess  = False   'Показывать ли текст ошибки на текущем компе 
'========================================================================== 
Dim objW, Mess, MarginPt, File, Ext, StartTime, CodeStr, Copies 
'Дюймы, выраженные в см., для вычисления полей 
Const Inch = 2.538 
'Задаем массив сообщений 
DefineMess 
'Включаем режим ручной обработки ошибок 
On Error Resume Next 
'Создаем объект Word 
Set objW = WScript.CreateObject("Word.Application") 
CheckErr(0) 
'Первый параметр - открываемый файл 
File = WScript.Arguments(0) 
CheckErr(1) 
'Открываем файл в кодировке, заданной третим параметром 
If WScript.Arguments.Count > 2 Then 
  CodeStr = WScript.Arguments(2) 
  If Len(CodeStr) <> 0 Then 
    objW.Documents.Open File,,1,,,,,,,,CodeStr 
  Else 
    objW.Documents.Open File,,1 
  End If 
Else 
  objW.Documents.Open File,,1 
End If 
CheckErr(1) 
'Вычисляем поля (задаются в пунктах - 1/72 дюйма) 
MarginPt = Margin/Inch * 72 
'Задаем поля для всех файлов, кроме *.doc и *.rtf 
Ext = LCase(CreateObject("Scripting.FileSystemObject").GetExtensionName(File)) 
If Not ((Ext = "doc") Or (Ext = "rtf")) Then 
  With objW.ActiveDocument.PageSetup 
    .LeftMargin   = MarginPt 
    .RightMargin  = MarginPt 
    .TopMargin    = MarginPt 
    .BottomMargin = MarginPt 
  End With 
  CheckErr(2) 
End If 
'Если задан второй параметр, то это принтер 
If WScript.Arguments.Count > 1 Then 
  'Устанавливаем принтер, если параметр не пустой 
  If Len(WScript.Arguments(1)) > 0 Then 
    'Устанавливаем текущий принтер - второй параметр 
    objW.ActivePrinter = WScript.Arguments(1) 
    'Небольшая пауза 
    WScript.Sleep 100 
    CheckErr(3) 
  End If 
End If 
'Количество копий 
If WScript.Arguments.Count > 3 Then 
  Copies = WScript.Arguments(3) 
Else 
  Copies = 1 
End If 
'Печатаем в фоне 
objW.PrintOut 1,,,,,,,Copies 
CheckErr(4) 
'Включаем таймер ожидания окончания печати 
StartTime = Timer 
'Ждем, пока закончится печать 
Do Until objW.BackgroundPrintingStatus = 0 
  'Если ожидаем уже больше заданного лимита 
  If (Timer - StartTime) > TimeLimit Then 
    'Генерим ошибку 
    Err.Raise vbObjectError + 1, Mess("Title"), Mess("Err1") 
    CheckErr(5) 
  End If 
  'Пауза 0.1 сек. 
  WScript.Sleep 100 
Loop 
'Закрываем Word 
objW.Quit 0 
CheckErr(6) 
'Отключаем режим ручной обработки ошибок 
On Error Goto 0 

'Выход 
Quit 

'Процедура задания массива сообщений 
Sub DefineMess 
  Set  Mess = CreateObject("Scripting.Dictionary") 
  With Mess 
    .Add "Title", "Печать документа" 
    .Add "Err1" , "Время ожидания окончания печати превысило заданный лимит. Печать прервана!" 
    .Add 0      , "При создании объекта Word возникла ошибка:" 
    .Add 1      , "Ошибка открытия файла:" 
    .Add 2      , "Ошибка задания полей:" 
    .Add 3      , "При установке активного принтера возникла ошибка:" 
    .Add 4      , "При выполнении печати документа возникла ошибка:" 
    .Add 5      , "Ошибка выполнения печати." 
    .Add 6      , "Ошибка закрытия документа. Закройте документ вручную." 
  End With 
End Sub 

'Процедура проверки ошибок 
Sub CheckErr(Step) 
  'Если произошла ошибка 
  If Err.Number <> 0 Then 
    'Посылаем сообщение на компьютер Admin 
    CreateObject("WScript.Shell").Run "net send " & Admin & " " &_ 
      Mess(Step) & vbNewLine & vbNewLine & Err.Description, 7, False 
    'Выводим сообщение на текущем компьютере 
    If ShowMess Then 
      MsgBox Mess(Step) & vbNewLine & vbNewLine & Err.Description, _ 
        vbOKOnly + vbCritical, Mess("Title") 
    End If 
    'Закрываем Word, если открыт 
    If (Step > 0) And IsObject(objW) Then 
      objW.Quit 0 
    End If 
    Quit 
  End If 
End Sub 

Sub Quit 
  Set Mess = Nothing 
  Set objW = Nothing 
  WScript.Quit 
End Sub