使用PrintOut()函数进行打印文档时，如何得知打印已经完成呢？

方法一：
'使用DoEvents，如下示例代码，在a.Quit加一个DoEvents循环就行Dim a As New Word.Application
    Dim b As New Word.Document    Set b = a.Documents.Add(StrFileName1)
    a.Visible = True
    b.PrintOut    Dim ys As Single
    ys = timer + 60 '60秒
    Do
       DoEvents
    Loop Until ys < timer    a.Quit   Set oc = Nothing
   Set ow = Nothing方法二：
GetPrinter:
Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long返回值
Long，非零表示成功，零表示失败。会设置GetLastError
参数表
参数类型及说明
hPrinter Long，一个已打开的打印机的句柄（用OpenPrinter获得）
Level Long，1，2，3（仅适用于NT），4（仅适用于NT），或者5（仅适用于Windows 95 和 NT 4.0）
pPrinter Any，包含PRINTER_INFO_x结构的缓冲区。x代表级别
cbBuf Long，pPrinterEnum缓冲区中的字符数量
pcbNeeded Long，指向一个Long型变量的指针，该变量用于保存请求的缓冲区长度，或者实际读入的字节数量 GetJob VB声明
Declare Function GetJob Lib "winspool.drv" Alias "GetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, pJob As Byte, ByVal cdBuf As Long, pcbNeeded As Long) As Long
说明
获取与指定作业有关的信息
返回值
Long，非零表示成功，零表示失败。会设置GetLastError
参数表
参数类型及说明
hPrinter Long，一个已打开的打印机的句柄（用OpenPrinter获得）
JobId Long，作业编号
Level Long，1或2
pJob Byte，包含JOB_INFO_1 或 JOB_INFO_2结构的缓冲区，结构中包含了与打印作业有关的信息
cbBuf Long，pJob缓冲区中的字符数量
pcbNeeded Long，指向一个Long型变量的指针，该变量用于保存请求的缓冲区长度，或者实际读入的字节数量

贴一个打印监控:
类CPrinters.cls
Option Explicit' Win32 API declarations
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long' Member variables
Private m_prns As Collection
Private m_VB5ErrorFlag As Boolean' Exposed events
Public Event PrinterAdded(ByVal DeviceName As String)' *********************************************
'  Initialize/Terminate
' *********************************************
Private Sub Class_Initialize()
   ' Initialize member objects
   Me.Refresh
End SubPrivate Sub Class_Terminate()
   ' Release member objects
   Set m_prns = Nothing
End Sub' *********************************************
'  Public Properties (Read-Only)
' *********************************************
Public Property Get Count() As Long
   ' Just return collection size.
   Count = m_prns.Count
End PropertyPublic Property Get Item(ByVal DevName As String) As CPrinterInfo
   ' Just allow errors to propogate up.
   Set Item = m_prns(DevName)
End PropertyPublic Property Get PrintersCollectionBad() As Boolean
   ' FIX: Printers Collection May Not Contain All Printers in the Printers Folder
   ' http://support.microsoft.com/support/kb/articles/Q253/6/12.ASP
   ' This property is meaningless *except* under VB5!!!
   PrintersCollectionBad = m_VB5ErrorFlag
End Property
' *********************************************
'  Public Methods
' *********************************************
Public Function NewEnum() As IUnknown
   ' Support enumeration of Item (default).
   Set NewEnum = m_prns.[_NewEnum]
End FunctionPublic Sub Refresh()
   Dim Buffer As String
   Dim BufSize As Long
   Dim nChars As Long
   Dim Devices() As String
   Dim inf As CPrinterInfo
   Dim i As Long

   ' VB5 fails because it never expands this value!
   ' Start with a reasonably sized buffer.
   BufSize = 512

   ' Attempt to get list of installed printers
   ' by looping until successful.
   Do
      Buffer = Space$(BufSize)
      nChars = GetProfileString("PrinterPorts", vbNullString, "", Buffer, BufSize)
      If nChars = (BufSize - 2) Then
         ' MSDN: If either lpAppName or lpKeyName is NULL and
         ' the supplied destination buffer is too small to hold
         ' all the strings, the last string is truncated and
         ' followed by two null characters. In this case, the
         ' return value is equal to nSize minus two.
         BufSize = BufSize * 2
      ElseIf nChars = 0 Then
         ' The call failed entirely.
         Exit Do
      Else
         ' We got a reasonable return.
         Exit Do
      End If
   Loop

   ' Build a fresh collection
   Set m_prns = New Collection
   Call ExtractStringZ(Buffer, Devices())
   For i = LBound(Devices) To UBound(Devices)
      Set inf = New CPrinterInfo
      inf.DeviceName = Devices(i)
      m_prns.Add inf, Devices(i)
      RaiseEvent PrinterAdded(Devices(i))
   Next i

   ' Set flag to indicate this system will
   ' choke if the Printers collection is
   ' queried from VB5.
   m_VB5ErrorFlag = (nChars > (1024 - 2))
End Sub' *********************************************
'  Private Methods
' *********************************************
Private Function ExtractStringZ(Buffer As String, OutArray() As String) As Long
   Dim StartPos As Long
   Dim NullPos As Long
   Dim BuffLen As Long
   Dim Elements As Long

   ' Extract null terminated strings from large
   ' double-null terminated buffer.
   StartPos = 1
   Elements = 0
   BuffLen = Len(Buffer)

   ' Loop through buffer looking for nulls.
   Do While StartPos < BuffLen
      NullPos = InStr(StartPos, Buffer, vbNullChar)
      If NullPos = StartPos Then
         ' We've hit the double-null terminator.
         Exit Do
      Else
         ' Expand array, store new substring, and
         ' increment counters.
         ReDim Preserve OutArray(0 To Elements) As String
         OutArray(Elements) = Mid$(Buffer, StartPos, NullPos - StartPos)
         StartPos = NullPos + 1
         Elements = Elements + 1
      End If
   Loop

   ' Return number of substrings found.
   ExtractStringZ = Elements
End Function
(待续)

接上面
类CPrinterJobs.cls:
Option Explicit' Win32 API declares
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrn As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA" (ByVal hPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, ByVal Level As Long, pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function SetJob Lib "winspool.drv" Alias "SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, pJob As Any, ByVal Command As Long) As Long
Private Declare Function GetJob Lib "winspool.drv" Alias "GetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long) As LongPrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type'  dwPlatformId defines:
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2' Need defaults to OpenPrinter in some cases
Private Type PRINTER_DEFAULTS
   pDatatype As String
   pDevMode As Long
   pDesiredAccess As Long
End TypePrivate Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)' The data area passed to a system call is too small.
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122' Job control constants
Private Const JOB_CONTROL_PAUSE = 1
Private Const JOB_CONTROL_RESUME = 2
Private Const JOB_CONTROL_CANCEL = 3
Private Const JOB_CONTROL_RESTART = 4
Private Const JOB_CONTROL_DELETE = 5
Private Const JOB_CONTROL_SENT_TO_PRINTER = 6
Private Const JOB_CONTROL_LAST_PAGE_EJECTED = 7Private Enum JobControlCodes
   jcPause = JOB_CONTROL_PAUSE
   jcResume = JOB_CONTROL_RESUME
   jcCancel = JOB_CONTROL_CANCEL
   jcRestart = JOB_CONTROL_RESTART
   jcDelete = JOB_CONTROL_DELETE
End Enum' Member variables
Private m_DevName As String
Private m_GetPrinterError As Long
Private m_jobs As Collection' *********************************************
'  Initialize/Terminate
' *********************************************
Private Sub Class_Initialize()
   ' Initialize member objects
   Set m_jobs = New Collection
End SubPrivate Sub Class_Terminate()
   ' Release member objects
   Set m_jobs = Nothing
End Sub' *********************************************
'  Public Properties (Read/Write)
' *********************************************
Public Property Get DeviceName() As String
   ' This is the name returned by a VB Printer
   ' object's .DeviceName property
   DeviceName = m_DevName
End PropertyPublic Property Let DeviceName(ByVal NewVal As String)
   m_DevName = NewVal
   Call Refresh
End Property' *********************************************
'  Public Properties (Derived, Read-Only)
' *********************************************
Public Property Get Count() As Long
   Dim nRet As Long
   ' Return actual number of jobs in queue.
   nRet = JobCount()
   If nRet <> m_jobs.Count Then
      ' Need to update collection!
      Call Refresh
   End If
   Count = nRet
End PropertyPublic Property Get Item(ByVal JobId As Variant) As CPrinterJobInfo
   ' Just allow errors to propogate up.
   Set Item = m_jobs(JobId)
End PropertyPublic Property Get GetPrinterError() As Long
   ' If the call to GetPrinter doesn't succeed,
   ' client needs to know LastDllError.
   GetPrinterError = m_GetPrinterError
End Property' *********************************************
'  Public Properties (Read-only)
' *********************************************
待续

接上面' *********************************************
'  Public Methods
' *********************************************
Public Function NewEnum() As IUnknown
   ' Support enumeration of Item (default).
   Set NewEnum = m_jobs.[_NewEnum]
End FunctionPublic Function ControlCancel(ByVal JobId As Long) As Boolean
   Dim os As OSVERSIONINFO
   ' NT4 is the dividing line between two different
   ' control codes for this call.
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)
   ' Attempt to cancel passed job.
   If os.dwPlatformId = VER_PLATFORM_WIN32_NT And os.dwMajorVersion >= 4 Then
      ControlCancel = SendControl(JobId, jcDelete)
   Else
      ControlCancel = SendControl(JobId, jcCancel)
   End If
End FunctionPublic Function ControlRestart(ByVal JobId As Long) As Boolean
   ' Attempt to resume passed job
   ControlRestart = SendControl(JobId, jcRestart)
End FunctionPublic Function ControlResume(ByVal JobId As Long) As Boolean
   ' Attempt to resume passed job
   ControlResume = SendControl(JobId, jcResume)
End FunctionPublic Function ControlPause(ByVal JobId As Long) As Boolean
   ' Attempt to pause passed job
   ControlPause = SendControl(JobId, jcPause)
End FunctionPublic Function PositionMoveDown(ByVal JobId As Long) As Boolean
   ' Attempt to adjust queue
   PositionMoveDown = AdjustJobPosition(JobId, 1)
End FunctionPublic Function PositionMoveUp(ByVal JobId As Long) As Boolean
   ' Attempt to adjust queue
   PositionMoveUp = AdjustJobPosition(JobId, -1)
End FunctionPublic Sub Refresh()
   Dim hPrn As Long
   Dim nJobs As Long
   Dim JobIds() As Long
   Dim Buffer() As Byte
   Dim BytesNeeded As Long
   Dim nReturned As Long
   Dim NewJob As CPrinterJobInfo
   Dim OldJob As CPrinterJobInfo
   Dim i As Long   ' Get handle to printer.
   Call OpenPrinter(m_DevName, hPrn, ByVal 0&)
   If hPrn Then
      ' Retrieve number of jobs.
      nJobs = JobCount(hPrn)
      If nJobs > 0 Then
         ' Setup array to stash job ids so we can remove
         ' dead jobs from collection
         ReDim JobIds(0 To nJobs - 1) As Long
         ' Call once to get proper buffer size.
         Call EnumJobs(hPrn, 0, nJobs, 2, ByVal 0&, 0, BytesNeeded, nReturned)
         If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
            ' Size buffer and get printer data.
            ReDim Buffer(0 To BytesNeeded - 1) As Byte
            If EnumJobs(hPrn, 0, nJobs, 2, Buffer(0), BytesNeeded, BytesNeeded, nReturned) Then
               ' Parse each returned structure into a
               ' class, and add to collection.
               For i = 0 To nReturned - 1
                  ' Update new object using new data.
                  Set NewJob = New CPrinterJobInfo
                  NewJob.Initialize VarPtr(Buffer(0)), i
                  ' Look to see if object exists for this job.
                  Set OldJob = GetJobInfo(NewJob.JobId)
                  If Not OldJob Is Nothing Then
                     ' Transfer previous max job size to new
                     ' object, and remove from collection.
                     NewJob.SizeMax = OldJob.SizeMax
                     NewJob.TotalPagesMax = OldJob.TotalPagesMax
                     m_jobs.Remove Hex$(OldJob.JobId)
                  End If
                  m_jobs.Add NewJob, Hex$(NewJob.JobId)
                  ' Store this job id
                  JobIds(i) = NewJob.JobId
               Next i
            End If
         End If
      End If
      Call ClosePrinter(hPrn)
   End If

   ' Clean out jobs collection of old jobs
   For Each OldJob In m_jobs
      If nJobs > 0 Then
         For i = LBound(JobIds) To UBound(JobIds)
            If OldJob.JobId = JobIds(i) Then Exit For
         Next i
         If i = UBound(JobIds) + 1 Then
            ' Didn't find a matching job!
            m_jobs.Remove Hex$(OldJob.JobId)
         End If
      Else
         ' No jobs, remove all
         m_jobs.Remove Hex$(OldJob.JobId)
      End If
   Next OldJob
End Sub' *********************************************
'  Private Methods
' *********************************************
Private Function AdjustJobPosition(ByVal JobId As Long, ByVal Delta As Long) As Boolean
   Dim pd As PRINTER_DEFAULTS
   Dim hPrn As Long
   Dim Buffer() As Byte
   Dim BytesNeeded As Long
   Dim Position As Long

   ' Requires PRINTER_ACCESS_ADMINISTER permissions.

   ' Get handle to printer.
   pd.pDesiredAccess = PRINTER_ACCESS_ADMINISTER
   Call OpenPrinter(m_DevName, hPrn, pd)
   If hPrn Then
      ' Call once to get proper buffer size.
      Call GetJob(hPrn, JobId, 1, ByVal 0&, 0&, BytesNeeded)
      If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
         ' Size buffer and get job data.
         ReDim Buffer(0 To BytesNeeded - 1) As Byte
         If GetJob(hPrn, JobId, 1, Buffer(0), BytesNeeded, BytesNeeded) Then
            ' Position is the 10th element in the structure.
            Const PositionOffset As Long = 9 * 4&
            Call CopyMemory(Position, Buffer(PositionOffset), 4&)
            Position = Position + Delta
            Call CopyMemory(Buffer(PositionOffset), Position, 4&)
            ' Attempt to update job data.
            AdjustJobPosition = CBool(SetJob(hPrn, JobId, 1, Buffer(0), 0))
         End If
      End If
      Call ClosePrinter(hPrn)
   End If
End FunctionPrivate Function GetJobInfo(ByVal JobId As Long) As CPrinterJobInfo
   On Error Resume Next
   Set GetJobInfo = m_jobs(Hex$(JobId))
End FunctionPrivate Function JobCount(Optional ByVal hPrn As Long = 0) As Long
   Dim Buffer() As Byte
   Dim BytesNeeded As Long
   Dim BytesUsed As Long
   Dim CloseHandle As Boolean

   ' If caller didn't open printer, we need to!
   If hPrn = 0 Then
      ' Get handle to printer.
      Call OpenPrinter(m_DevName, hPrn, ByVal 0&)
      CloseHandle = True
   End If   If hPrn Then
      ' Call once to get proper buffer size.
      Call GetPrinter(hPrn, 2, ByVal 0&, 0, BytesNeeded)
      If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
         ' Size buffer and get printer data.
         ReDim Buffer(0 To BytesNeeded - 1) As Byte
         If GetPrinter(hPrn, 2, Buffer(0), BytesNeeded, BytesUsed) Then
            ' cJobs is the 20th 4-byte element of the
            ' PRINTER_INFO_2 structure.
            Const JobsOffset As Long = 19 * 4&
            Call CopyMemory(JobCount, Buffer(JobsOffset), 4&)
         End If
         m_GetPrinterError = 0  'clear error value
      Else
         m_GetPrinterError = Err.LastDllError
      End If
   End If

   ' If we opened printer, need to close it too.
   If CloseHandle Then Call ClosePrinter(hPrn)
End FunctionPrivate Function SendControl(ByVal JobId As Long, ByVal ControlCode As JobControlCodes) As Boolean
   Dim hPrn As Long
   ' Get handle to printer.
   Call OpenPrinter(m_DevName, hPrn, ByVal 0&)
   If hPrn Then
      ' Send requested control code.
      SendControl = CBool(SetJob(hPrn, JobId, 0, ByVal 0&, ControlCode))
      Call ClosePrinter(hPrn)
      ' Update all object data.
      Call Me.Refresh
   End If
End Function待续

调试易

使用PrintOut()函数进行打印文档时，如何得知打印已经完成呢？

解决方案 »