Печать с использованием функции Shell

Sub Procedure_1()
 
    Const sPathApplication As String = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe"
    Const sFilePath As String = "C:\Documents and Settings\Пользователь\Рабочий стол\Документ 1.pdf"
    
    'WindowStyle:=vbNormalFocus используется для виртуальных принтеров,
    'чтобы было видно диалоговое окно, которое появляется
    'когда файл отправляют на печать.
    'В случае Adobe Reader в любом случае появится диалоговое окно программы.
    'Это же происходит, если распечатать файл, щ. по нему правой кн. мыши и выбрав "Печать".
    Shell PathName:=sPathApplication & " /p /h " & sFilePath, WindowStyle:=vbNormalFocus
        
End Sub

Sub PrintPDF()
Const sPathApplication As String = """c:\Program Files (x86)\Adobe\Reader 10.0\Reader\acrord32.exe"""
Const sFilePath As String = """e:\iac_api_reference.pdf"""
 
With CreateObject("WScript.Shell")
  'Печатаем на виртуальном принтере
  .Run sPathApplication & " /h /t " & sFilePath & """doPDF v7"" ""doPDF 7 Printer Driver"" ""DOP7""", 0, True
  'Печатаем на реальном принтере (указывать все параметры, даже если это Ваш принтер по-умолчанию)
  .Run sPathApplication & " /h /t " & sFilePath & """Canon LBP2900"" ""Canon LBP2900"" ""USB001""", 0, True
  .Run "taskkill /f /im:AcroRD32.exe", 0 'Закрыть Adobe Reader
End With
'True - сценарий возобновит работу только после завершения вызванного процесса.
End Sub

Option Explicit
 
Sub main()
'Const sPathAdobe As String = "c:\Program Files (x86)\Adobe\Reader 10.0\Reader\acrord32.exe"
Dim sFilePath$(1 To 2)
Dim PrinterName$, DriverName$, Port$
 
PrinterName = "Canon LBP2900"
DriverName = "Canon LBP2900"
Port = "USB001"
 
'Список файлов для печати в массив
sFilePath(1) = "e:\NVEFSRestoreTool_Manual.pdf"
sFilePath(2) = "e:\123.pdf"
 
Call PrintPDF(sFilePath, PrinterName, DriverName, Port)
End Sub
 
Sub PrintPDF(ByVal sFilePath, ByVal PrinterName$, ByVal DriverName$, ByVal Port$)
Dim WshShell As Object, sPathAdobe$, File
Set WshShell = CreateObject("WScript.Shell")
 
'Получаем путь к программе Adobe Reader через реестр
sPathAdobe = WshShell.RegRead("HKCR\Software\Adobe\Acrobat\Exe\")
 
For Each File In sFilePath 'Печатаем каждый файл через WshShell
  WshShell.Run _
  sPathAdobe & _
  " /h /t " & _
  """" & File & """ " & _
  """" & PrinterName & """ " & _
  """" & DriverName & """ " & _
  """" & Port & """", 0, False
  Call Wait_For_Printing_Complete
  Call KillTask(sPathAdobe)
Next
Set WshShell = Nothing
End Sub
 
Sub KillTask(ByVal FileName$) 'Закрыть Adobe Reader
If InStr(FileName, "\") <> 0 Then FileName = Mid$(FileName, InStrRev(FileName, "\") + 1)
CreateObject("WScript.Shell").Run "taskkill /f /im:" & FileName, 0, True
End Sub
 
Sub Wait_For_Printing_Complete() 'Слежение за очередью печати
Dim oLocator As Object, oService As Object
 
Set oLocator = CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer("", "", "", "") 'Задания от всех пользователей
 
oService.Security_.impersonationlevel = 3 'получаем необходимые права
oService.Security_.Privileges.AddAsString "SeLoadDriverPrivilege"
 
'Ожидаем постановки в печать
Do While oService.InstancesOf("Win32_PrintJob").Count = 0
    DoEvents
Loop
 
'Ожидаем завершения печати
Do Until oService.InstancesOf("Win32_PrintJob").Count = 0
    Pause 1
Loop
 
Set oLocator = Nothing
Set oService = Nothing
End Sub
 
Sub Pause(Sec&) 'пауза в секундах
Dim t!
t = Timer
Do
    DoEvents
Loop Until Timer > t + 1 Or Timer < t
End Sub

Declare Function FindWindowA Lib "User32.dll" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Option Explicit
 
'Функция для получения манипулятора окна открываемого для печати PDF-файла.
'Манипулятор - это просто число, через которое можно обратиться к нужному окну.
'Нам манипулятор нужен, чтобы:
    '1. определить, открыт ли документ PDF;
    '2. определить, закрыт ли документ PDF.
Declare Function FindWindowA Lib "User32.dll" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Sub Procedure_1()
 
    'Путь к программе Adobe Reader.
    Const sAppPath = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe"
    
    Dim sPrinterName As String
    Dim sArray(1 To 2) As String
    Dim i As Long
    
    Dim apiHWnd As Long
    Dim apiWindowHeader As String
    
    'Указываем имя принтера. Имя принтера можно посмотреть:
    'Пуск - Панель управления - Принтеры и другое оборудование - Принтеры и факсы.
    'Добавляем кавычки к имени принтера, чтобы сформировать командную строку.
    'Кавычки нужно использовать, чтобы компьютер различал, где указано имя файла,
    'а где имя принтера.
    'Chr(34) - это кавычки.
    sPrinterName = Chr(34) & "doPDF v7" & Chr(34)
    
    'Указываем, какие файлы распечатывать.
    sArray(1) = "C:\Documents and Settings\Пользователь\Рабочий стол\Файлы PDF\Документ 1.pdf"
    sArray(2) = "C:\Documents and Settings\Пользователь\Рабочий стол\Файлы PDF\Документ 2.pdf"
    
    'Распечатываем PDF-файлы.
    
    For i = 1 To UBound(sArray) Step 1
    
        'Запуск PDF-файла на печать.
        'vbNormalFocus - для виртуальных принтеров, чтобы было видно
        'диалоговое окно печати.
        Shell sAppPath & " /t" & Chr(34) & sArray(i) & Chr(34) & sPrinterName, vbNormalFocus
        
        'Указываем, какой заголовок окна нас интересует.
        apiWindowHeader = Dir(sArray(i)) & " - Adobe Reader"
    
        'Ждём, когда на мониторе появится окно PDF-файла
        '(вверху этого окна будете соответствующий текст,
        'например: "Документ 1.pdf - Adobe Reader".
        Do
            apiHWnd = FindWindowA(vbNullString, apiWindowHeader)
            If apiHWnd <> 0 Then
                Exit Do
            End If
            'Хоть печать и осуществляется в другой программе (Adobe Reader),
            'цикл не даёт открыться окну PDF-файла, поэтому нужно добавить DoEvents.
            DoEvents
        Loop
    
        'Ждём, когда закроется открытый для печати PDF-документ.
        'В этом случае на мониторе не станет окна с заголовком PDF-документа.
        Do
            apiHWnd = FindWindowA(vbNullString, apiWindowHeader)
            If apiHWnd = 0 Then
                Exit Do
            End If
            DoEvents
        Loop
        
    Next i
    
End Sub