Total Commander

Код: Выделить всё

objW.PrintOut 1,,,,,,,Copies,"1"

Код: Выделить всё

objW.PrintOut 1,,,,,,,Copies

Код: Выделить всё

objW.PrintOut 1, , 4, , , , , Copies, "1"
'objW.PrintOut 1, , 4, , , , , Copies, "2"

Код: Выделить всё

"{{%L}}" "" "" "" 1

Код: Выделить всё

"{{%L}}

Код: Выделить всё

"{{%L}} "" "" 3

Код: Выделить всё

"{{%L}} "" 1251

Код: Выделить всё

"{{%L}} "" "" ""

Код: Выделить всё

'==========================================================================
' Печать нескольких документов с помощью MS Word
'
' Параметры:
' {Файл-список} [{Принтер} [{Кодовая страница} [{Количество копий} [{Номер(а) страниц}]]]]
' При пустом параметре (указывается "") используются значения по умолчанию
'
' Пример параметров при вызове из TC:
' %WL \\Host\HostPrinter 1251 "" "1"
'
' Автор - Batya
'==========================================================================
Option Explicit
Dim Docs
'================= Изменяемые параметры ===================================
Const TimeLimit = 30      'Время ожидания окончания печати в сек.
Const Margin    = 1.5     'Поля в см
'Список расширений документов с наличием форматирования
Docs = Array("rtf","doc","docx")
'==========================================================================
Dim FSO, WSH, objW, Mess, ListF, List, Printer, CodePage, Copies, Pages, F
'Дюймы, выраженные в см., для вычисления полей
Const Inch = 2.538
SetMess
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
'Включаем режим ручной обработки ошибок
On Error Resume Next
CheckParam                                         :CheckErr 1,0
'Создаем объект Word
Set objW = CreateObject("Word.Application")        :CheckErr 1,1
'Если задан принтер
If Printer <> "" Then objW.ActivePrinter = Printer :CheckErr 1,1 : WScript.Sleep 500
'Цикл по файлам
For Each F In List
  If Trim(F) <> "" Then
    F = GetPath(F)
    'Обрабатываем только файлы
    If FSO.FileExists(F) Then Print(F)             :CheckErr 0,1
  End If
Next
'Отключаем режим ручной обработки ошибок
On Error Goto 0
'Закрываем Word
objW.Quit 0
'Сообщение об окончании работы
MessBox Mess(99), 3
'Выход
Quit 0

'Открытие и печать документа
Sub Print(pFile)
  Dim Doc, MarginPt, StartTime, WdPrintOutRange
  'Открываем документ
  Set Doc = objW.Documents.Open(pFile,False,True,False,,,,,,,CodePage)
  'Задаем поля для документов без оформления
  If InStr(1, "\" & Join(Docs, "\") & "\", "\" & FSO.GetExtensionName(pFile) & "\", 1) > 0 Then
    'Поля в пунктах (1/72 дюйма)
    MarginPt = Margin/Inch * 72
    With Doc.PageSetup
      .LeftMargin   = MarginPt
      .RightMargin  = MarginPt
      .TopMargin    = MarginPt
      .BottomMargin = MarginPt
    End With
  End If
  If Pages <> "" Then
    WdPrintOutRange = 4
  Else
    WdPrintOutRange = 0
  End If
  'Печатаем
  objW.PrintOut True,,WdPrintOutRange,,,,,Copies,Pages
  'Включаем таймер ожидания окончания печати
  StartTime = Timer
  'Ждем, пока закончится печать
  Do Until objW.BackgroundPrintingStatus = 0
    'Если ожидаем уже больше заданного лимита, выходим с ошибкой
    If (Timer - StartTime) > TimeLimit Then Err.Raise vbObjectError + 4, Mess(0), Mess(4)
    'Пауза 0.1 сек.
    WScript.Sleep 100
  Loop
  'Закрываем документ
  Doc.Close(False)
  Set Doc = Nothing
End Sub

'Проверка параметров
Sub CheckParam
  Dim lArg
  Set lArg = WScript.Arguments
  If lArg.Count = 0 Then Err.Raise vbObjectError + 1, Mess(0), Mess(1)
  'Файл-список
  ListF = GetPath(lArg(0))
  If Not FSO.FileExists(ListF) Then Err.Raise vbObjectError + 2, Mess(0), Mess(2)
  'Массив файлов\папок
  List = Split(FSO.OpenTextFile(ListF, 1, False, -1).ReadAll, vbNewLine)
  'Принтер
  Printer  = "" : If lArg.Count > 1 Then Printer  = lArg(1)
  'Кодовая страница
  CodePage = "" : If lArg.Count > 2 Then CodePage = lArg(2)
  'Количество копий
  Copies   = 1  : If lArg.Count > 3 Then Copies   = lArg(3)
  If Copies = "" Then Copies = 1
  If Not IsNumeric(Copies) Then Err.Raise vbObjectError + 3, Mess(0), Mess(3)
  'Номер(а) страниц
  Pages = ""    : If lArg.Count > 4 Then Pages    = lArg(4)
End Sub

'Сообщение
Function MessBox(pMess, pMode)
  Dim lIcon
  Select Case pMode
    Case 1 lIcon = vbCritical    + vbOKOnly
    Case 2 lIcon = vbExclamation + vbOKOnly
    Case 3 lIcon = vbInformation + vbOKOnly
    Case 4 lIcon = vbExclamation + vbOKCancel
  End Select
  MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

Function GetPath(pPath)
  GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function

'Проверка ошибок
Sub CheckErr(pMode1, pMode2)
  Dim Flag
  If Err.Number <> 0 Then
    If pMode1 = 1 Then 'Безусловный выход
      'Выводим сообщение
      MessBox Mess(-1) & Err.Description, 1
      Flag = vbOK
    Else 'Выход по запросу
      'Выводим сообщение
      Flag = MessBox(Mess(-1) & Err.Description & Mess(-2), 4)
    End If
    If Flag = vbOK Then
      If pMode2 = 1 Then
        If IsObject(Doc)  Then Doc.Close(False)
        If IsObject(objW) Then objW.Quit
      End If
      Quit Err.Number
    End If
  End If
End Sub

'Задание массива сообщений
Sub SetMess
  Set Mess = CreateObject("Scripting.Dictionary")
  With Mess
    .Add -1, "Возникла ошибка:" & vbNewLine & vbNewLine
    .Add -2, vbNewLine & vbNewLine & "Прервать работу скрипта?"
    .Add  0, "Печать документов"
    .Add  1, "Не указаны входные параметры!"
    .Add  2, "Файл-список не существует!"
    .Add  3, "Указано некорректное количество копий!"
    .Add  4, "Превышено время ожидания окончания печати."
    .Add 99, "Операция завершена."
  End With
End Sub

'Выход
Sub Quit(pQuitCode)
  Set Mess = Nothing
  Set objW = Nothing
  Set WSH  = Nothing
  Set FSO  = Nothing
  WScript.Quit pQuitCode
End Sub

Код: Выделить всё

If Printer <> "" Then objW.ActivePrinter = Printer :CheckErr 1,1 : WScript.Sleep 500

Код: Выделить всё

  If Pages <> "" Then 
    WdPrintOutRange = 4 
  Else 
    WdPrintOutRange = 0 
  End If

Код: Выделить всё

List = Split(FSO.OpenTextFile(ListF, 1, False, -1).ReadAll, vbNewLine)
For Each F In List 
  If Trim(F) <> "" Then 
    F = GetPath(F) 
    'Обрабатываем только файлы 
    If FSO.FileExists(F) Then Print(F)             :CheckErr 0,1 
  End If 
Next

Код: Выделить всё

Set List = FSO.GetFile(ListF).OpenAsTextStream(1, -1) 
Do While Not List.AtEndOfStream 
  F = GetPath(List.ReadLine)
  If FSO.FileExists(F) Then Print(F)             :CheckErr 0,1
Loop : List.Close