Avisar impressora desligada

Boa tarde Amigos

Tem como ao mandar imprimir um relatório num click de um comando se a impressora estiver desligada, receber um aviso tipo.

Msgbox"Impressora Desligada".

Obrigado

Boa noite

Alguém dá um help.

Link

tomasvasquez.com.br/blog/microsoft-office/vba-verificar-se-impressora-padrao-esta-desligada/


Obrogado

Qual o problema com o código do link que você passou?

Boa tarde Ivan

Queria aplicar no formulário "frmPrint" no botão de imprimir e se a impressora estiver desligada avisa e não imprime.

Obrigado

O segundo código na página q vc passou tem a parte pra esses avisos. Mas especificamente esse trecho

Código:

For Each objPrinter In colInstalledPrinters
        ...Case Else
            MsgBox "A impressora está desativada"
        End Select
    Next

Ivan

Com a impressora desligada ou ligada dá sempre como "A impressora está ociosa".

Estou a fazer errado ?

Teste por favor

Obrigado

up

Bom día Assis

Você coloca o código abaixo em um novo módulo, por exemplo, basPrinterStatus:

Código:

Option Compare Database

Option Explicit

Public Declare Function lstrcpy Lib "kernel32" _
  Alias "lstrcpyA" _
  (ByVal lpString1 As String, _
  ByVal lpString2 As String) _
  As Long

Public Declare Function OpenPrinter Lib "winspool.drv" _
  Alias "OpenPrinterA" _
  (ByVal pPrinterName As String, _
  phPrinter As Long, _
  pDefault As PRINTER_DEFAULTS) _
  As Long

Public Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _
  (ByVal hPrinter As Long, _
  ByVal Level As Long, _
  pPrinter As Byte, _
  ByVal cbBuf As Long, _
  pcbNeeded As Long) _
  As Long

Public Declare Function ClosePrinter Lib "winspool.drv" _
  (ByVal hPrinter As Long) _
  As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (Destination As Any, _
  Source As Any, _
  ByVal Length As Long)

Public 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 Byte, _
  ByVal cdBuf As Long, _
  pcbNeeded As Long, _
  pcReturned As Long) _
  As Long
 
' constants for PRINTER_DEFAULTS structure
Public Const PRINTER_ACCESS_USE = &H8
Public Const PRINTER_ACCESS_ADMINISTER = &H4

' constants for DEVMODE structure
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

Public Type PRINTER_DEFAULTS
  pDatatype As String
  pDevMode As Long
  DesiredAccess As Long
End Type

Public Type DEVMODE
  dmDeviceName As String * CCHDEVICENAME
  dmSpecVersion As Integer
  dmDriverVersion As Integer
  dmSize As Integer
  dmDriverExtra As Integer
  dmFields As Long
  dmOrientation As Integer
  dmPaperSize As Integer
  dmPaperLength As Integer
  dmPaperWidth As Integer
  dmScale As Integer
  dmCopies As Integer
  dmDefaultSource As Integer
  dmPrintQuality As Integer
  dmColor As Integer
  dmDuplex As Integer
  dmYResolution As Integer
  dmTTOption As Integer
  dmCollate As Integer
  dmFormName As String * CCHFORMNAME
  dmLogPixels As Integer
  dmBitsPerPel As Long
  dmPelsWidth As Long
  dmPelsHeight As Long
  dmDisplayFlags As Long
  dmDisplayFrequency As Long
End Type

Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Type JOB_INFO_2
  JobId As Long
  pPrinterName As Long
  pMachineName As Long
  pUserName As Long
  pDocument As Long
  pNotifyName As Long
  pDatatype As Long
  pPrintProcessor As Long
  pParameters As Long
  pDriverName As Long
  pDevMode As Long
  pStatus As Long
  pSecurityDescriptor As Long
  Status As Long
  Priority As Long
  Position As Long
  StartTime As Long
  UntilTime As Long
  TotalPages As Long
  Size As Long
  Submitted As SYSTEMTIME
  time As Long
  PagesPrinted As Long
End Type

Type PRINTER_INFO_2
  pServerName As Long
  pPrinterName As Long
  pShareName As Long
  pPortName As Long
  pDriverName As Long
  pComment As Long
  pLocation As Long
  pDevMode As Long
  pSepFile As Long
  pPrintProcessor As Long
  pDatatype As Long
  pParameters As Long
  pSecurityDescriptor As Long
  Attributes As Long
  Priority As Long
  DefaultPriority As Long
  StartTime As Long
  UntilTime As Long
  Status As Long
  cJobs As Long
  AveragePPM As Long
End Type

Public Const ERROR_INSUFFICIENT_BUFFER = 122
Public Const PRINTER_STATUS_BUSY = &H200
Public Const PRINTER_STATUS_DOOR_OPEN = &H400000
Public Const PRINTER_STATUS_ERROR = &H2
Public Const PRINTER_STATUS_INITIALIZING = &H8000
Public Const PRINTER_STATUS_IO_ACTIVE = &H100
Public Const PRINTER_STATUS_MANUAL_FEED = &H20
Public Const PRINTER_STATUS_NO_TONER = &H40000
Public Const PRINTER_STATUS_NOT_AVAILABLE = &H1000
Public Const PRINTER_STATUS_OFFLINE = &H80
Public Const PRINTER_STATUS_OUT_OF_MEMORY = &H200000
Public Const PRINTER_STATUS_OUTPUT_BIN_FULL = &H800
Public Const PRINTER_STATUS_PAGE_PUNT = &H80000
Public Const PRINTER_STATUS_PAPER_JAM = &H8
Public Const PRINTER_STATUS_PAPER_OUT = &H10
Public Const PRINTER_STATUS_PAPER_PROBLEM = &H40
Public Const PRINTER_STATUS_PAUSED = &H1
Public Const PRINTER_STATUS_PENDING_DELETION = &H4
Public Const PRINTER_STATUS_PRINTING = &H400
Public Const PRINTER_STATUS_PROCESSING = &H4000
Public Const PRINTER_STATUS_TONER_LOW = &H20000
Public Const PRINTER_STATUS_USER_INTERVENTION = &H100000
Public Const PRINTER_STATUS_WAITING = &H2000
Public Const PRINTER_STATUS_WARMING_UP = &H10000
Public Const JOB_STATUS_PAUSED = &H1
Public Const JOB_STATUS_ERROR = &H2
Public Const JOB_STATUS_DELETING = &H4
Public Const JOB_STATUS_SPOOLING = &H8
Public Const JOB_STATUS_PRINTING = &H10
Public Const JOB_STATUS_OFFLINE = &H20
Public Const JOB_STATUS_PAPEROUT = &H40
Public Const JOB_STATUS_PRINTED = &H80
Public Const JOB_STATUS_DELETED = &H100
Public Const JOB_STATUS_BLOCKED_DEVQ = &H200
Public Const JOB_STATUS_USER_INTERVENTION = &H400
Public Const JOB_STATUS_RESTART = &H800

Public Function GetString(ByVal PtrStr As Long) As String
  Dim StrBuff As String * 256
 
  'Check for zero address
  If PtrStr = 0 Then
  GetString = " "
  Exit Function
  End If
 
  'Copy data from PtrStr to buffer.
  CopyMemory ByVal StrBuff, ByVal PtrStr, 256
 
  'Strip any trailing nulls from string.
  GetString = StripNulls(StrBuff)
End Function

Public Function StripNulls(OriginalStr As String) As String
  'Strip any trailing nulls from input string.
  If (InStr(OriginalStr, Chr(0)) > 0) Then
  OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
  End If

  'Return modified string.
  StripNulls = OriginalStr
End Function

Public Function PtrCtoVbString(Add As Long) As String
  Dim sTemp As String * 512
  Dim x As Long

  x = lstrcpy(sTemp, Add)
  If (InStr(1, sTemp, Chr(0)) = 0) Then
    PtrCtoVbString = ""
  Else
    PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
  End If
End Function

Public Function CheckPrinterStatus(PI2Status As Long) As String
  Dim tempStr As String
 
  If PI2Status = 0 Then  ' Return "Ready"
  CheckPrinterStatus = "Printer Status = Ready" & vbCrLf
  Else
  tempStr = ""  ' Clear
  If (PI2Status And PRINTER_STATUS_BUSY) Then
    tempStr = tempStr & "Busy "
  End If
 
  If (PI2Status And PRINTER_STATUS_DOOR_OPEN) Then
    tempStr = tempStr & "Printer Door Open "
  End If
 
  If (PI2Status And PRINTER_STATUS_ERROR) Then
    tempStr = tempStr & "Printer Error "
  End If
 
  If (PI2Status And PRINTER_STATUS_INITIALIZING) Then
    tempStr = tempStr & "Initializing "
  End If
 
  If (PI2Status And PRINTER_STATUS_IO_ACTIVE) Then
    tempStr = tempStr & "I/O Active "
  End If

  If (PI2Status And PRINTER_STATUS_MANUAL_FEED) Then
    tempStr = tempStr & "Manual Feed "
  End If
 
  If (PI2Status And PRINTER_STATUS_NO_TONER) Then
    tempStr = tempStr & "No Toner "
  End If
 
  If (PI2Status And PRINTER_STATUS_NOT_AVAILABLE) Then
    tempStr = tempStr & "Not Available "
  End If
 
  If (PI2Status And PRINTER_STATUS_OFFLINE) Then
    tempStr = tempStr & "Off Line "
  End If
 
  If (PI2Status And PRINTER_STATUS_OUT_OF_MEMORY) Then
    tempStr = tempStr & "Out of Memory "
  End If
 
  If (PI2Status And PRINTER_STATUS_OUTPUT_BIN_FULL) Then
    tempStr = tempStr & "Output Bin Full "
  End If
 
  If (PI2Status And PRINTER_STATUS_PAGE_PUNT) Then
    tempStr = tempStr & "Page Punt "
  End If
 
  If (PI2Status And PRINTER_STATUS_PAPER_JAM) Then
    tempStr = tempStr & "Paper Jam "
  End If

  If (PI2Status And PRINTER_STATUS_PAPER_OUT) Then
    tempStr = tempStr & "Paper Out "
  End If
 
  If (PI2Status And PRINTER_STATUS_OUTPUT_BIN_FULL) Then
    tempStr = tempStr & "Output Bin Full "
  End If
 
  If (PI2Status And PRINTER_STATUS_PAPER_PROBLEM) Then
    tempStr = tempStr & "Page Problem "
  End If
 
  If (PI2Status And PRINTER_STATUS_PAUSED) Then
    tempStr = tempStr & "Paused "
  End If

  If (PI2Status And PRINTER_STATUS_PENDING_DELETION) Then
    tempStr = tempStr & "Pending Deletion "
  End If
 
  If (PI2Status And PRINTER_STATUS_PRINTING) Then
    tempStr = tempStr & "Printing "
  End If
 
  If (PI2Status And PRINTER_STATUS_PROCESSING) Then
    tempStr = tempStr & "Processing "
  End If
 
  If (PI2Status And PRINTER_STATUS_TONER_LOW) Then
    tempStr = tempStr & "Toner Low "
  End If

  If (PI2Status And PRINTER_STATUS_USER_INTERVENTION) Then
    tempStr = tempStr & "User Intervention "
  End If
 
  If (PI2Status And PRINTER_STATUS_WAITING) Then
    tempStr = tempStr & "Waiting "
  End If
 
  If (PI2Status And PRINTER_STATUS_WARMING_UP) Then
    tempStr = tempStr & "Warming Up "
  End If
 
  'Did you find a known status?
  If Len(tempStr) = 0 Then
    tempStr = "Unknown Status of " & PI2Status
  End If
 
  'Return the Status
  CheckPrinterStatus = "Printer Status = " & tempStr & vbCrLf
  End If
End Function

Em seguida, em um Formulário, por exemplo, frmTest, você coloca três caixas de texto:

txtCheckPrinter, txtPrinterStatus and txtJobStatus.

Você define o Intervalo do temporizador de formulário em 500 e, em seguida, coloca o seguinte código no evento no temporizador:

Código:

 Dim PrinterStatus As String
 Dim JobStatus As String
 
Me.txtCheckPrinter = CheckPrinter(PrinterStatus, JobStatus)
Me.txtPrinterStatus = PrinterStatus
Me.txtJobStatus = JobStatus

Agora, ao abrir o Formulário, você verá o status da Impressora padrão do seu computador.

Saludos

Franklin

Testou ?

No meu acontece o seguinte ver imagem:

Onde errei ?

Segue exemplo

Obrigado

Up

Assis, o que lhe passaram usa API`s do Windows e penso que o seu Office é 64 bits.

Tem de usar o PtrSafe.

Penso eu, que não vi.

Ok, já vi de onde saíu esse código.

Falta ae esta função;

Código:

Public Function CheckPrinter(PrinterStr As String, JobStr As String) As String
  Dim hPrinter As Long
  Dim ByteBuf As Long
  Dim BytesNeeded As Long
  Dim PI2 As PRINTER_INFO_2
  Dim JI2 As JOB_INFO_2
  Dim PrinterInfo() As Byte
  Dim JobInfo() As Byte
  Dim result As Long
  Dim LastError As Long
  Dim PrinterName As String
  Dim tempStr As String
  Dim NumJI2 As Long
  Dim pDefaults As PRINTER_DEFAULTS
  Dim I As Integer

  'Set a default return value if no errors occur.
  CheckPrinter = "Printer info retrieved"

  'NOTE: You can pick a printer from the Printers Collection
  'or use the EnumPrinters() API to select a printer name.

  'Use the default printer of Printers collection.
  'This is typically, but not always, the system default printer.
  PrinterName = Printer.DeviceName

  'Set desired access security setting.
  pDefaults.DesiredAccess = PRINTER_ACCESS_USE

  'Call API to get a handle to the printer.
  result = OpenPrinter(PrinterName, hPrinter, pDefaults)
  If result = 0 Then
      'If an error occurred, display an error and exit sub.
      CheckPrinter = "Cannot open printer " & PrinterName & _
        ", Error: " & Err.LastDllError
      Exit Function
  End If

  'Init BytesNeeded
  BytesNeeded = 0

  'Clear the error object of any errors.
  Err.Clear

  'Determine the buffer size that is needed to get printer info.
  result = GetPrinter(hPrinter, 2, 0&, 0&, BytesNeeded)

  'Check for error calling GetPrinter.
  If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
      'Display an error message, close printer, and exit sub.
      CheckPrinter = " > GetPrinter Failed on initial call! <"
      ClosePrinter hPrinter
      Exit Function
  End If

  'Note that in Charles Petzold's book "Programming Windows 95," he
  'states that because of a problem with GetPrinter on Windows 95 only, you
  'must allocate a buffer as much as three times larger than the value
  'returned by the initial call to GetPrinter. This is not done here.
  ReDim PrinterInfo(1 To BytesNeeded)

  ByteBuf = BytesNeeded

  'Call GetPrinter to get the status.
  result = GetPrinter(hPrinter, 2, PrinterInfo(1), ByteBuf, _
    BytesNeeded)

  'Check for errors.
  If result = 0 Then
      'Determine the error that occurred.
      LastError = Err.LastDllError()

      'Display error message, close printer, and exit sub.
      CheckPrinter = "Couldn't get Printer Status!  Error = " _
        & LastError
      ClosePrinter hPrinter
      Exit Function
  End If

  'Copy contents of printer status byte array into a
  'PRINTER_INFO_2 structure to separate the individual elements.
  CopyMemory PI2, PrinterInfo(1), Len(PI2)

  'Check if printer is in ready state.
  PrinterStr = CheckPrinterStatus(PI2.Status)

  'Add printer name, driver, and port to list.
  PrinterStr = PrinterStr & "Printer Name = " & _
    GetString(PI2.pPrinterName) & vbCrLf
  PrinterStr = PrinterStr & "Printer Driver Name = " & _
    GetString(PI2.pDriverName) & vbCrLf
  PrinterStr = PrinterStr & "Printer Port Name = " & _
    GetString(PI2.pPortName) & vbCrLf

  'Call API to get size of buffer that is needed.
  result = EnumJobs(hPrinter, 0&, &HFFFFFFFF, 2, ByVal 0&, 0&, _
      BytesNeeded, NumJI2)

  'Check if there are no current jobs, and then display appropriate message.
  If BytesNeeded = 0 Then
      JobStr = "No Print Jobs!"
  Else
      'Redim byte array to hold info about print job.
      ReDim JobInfo(0 To BytesNeeded)

      'Call API to get print job info.
      result = EnumJobs(hPrinter, 0&, &HFFFFFFFF, 2, JobInfo(0), _
        BytesNeeded, ByteBuf, NumJI2)

      'Check for errors.
      If result = 0 Then
        'Get and display error, close printer, and exit sub.
        LastError = Err.LastDllError
        CheckPrinter = " > EnumJobs Failed on second call! <  Error = " _
            & LastError
        ClosePrinter hPrinter
        Exit Function
      End If

      'Copy contents of print job info byte array into a
      'JOB_INFO_2 structure to separate the individual elements.
      For I = 0 To NumJI2 - 1  ' Loop through jobs and walk the buffer
          CopyMemory JI2, JobInfo(I * Len(JI2)), Len(JI2)

          ' List info available on Jobs.
          Debug.Print "Job ID" & vbTab & JI2.JobId
          Debug.Print "Name Of Printer" & vbTab & _
            GetString(JI2.pPrinterName)
          Debug.Print "Name Of Machine That Created Job" & vbTab & _
            GetString(JI2.pMachineName)
          Debug.Print "Print Job Owner's Name" & vbTab & _
            GetString(JI2.pUserName)
          Debug.Print "Name Of Document" & vbTab & GetString(JI2.pDocument)
          Debug.Print "Name Of User To Notify" & vbTab & _
            GetString(JI2.pNotifyName)
          Debug.Print "Type Of Data" & vbTab & GetString(JI2.pDatatype)
          Debug.Print "Print Processor" & vbTab & _
            GetString(JI2.pPrintProcessor)
          Debug.Print "Print Processor Parameters" & vbTab & _
            GetString(JI2.pParameters)
          Debug.Print "Print Driver Name" & vbTab & _
            GetString(JI2.pDriverName)
          Debug.Print "Print Job 'P' Status" & vbTab & _
            GetString(JI2.pStatus)
          Debug.Print "Print Job Status" & vbTab & JI2.Status
          Debug.Print "Print Job Priority" & vbTab & JI2.Priority
          Debug.Print "Position in Queue" & vbTab & JI2.Position
          Debug.Print "Earliest Time Job Can Be Printed" & vbTab & _
            JI2.StartTime
          Debug.Print "Latest Time Job Will Be Printed" & vbTab & _
            JI2.UntilTime
          Debug.Print "Total Pages For Entire Job" & vbTab & JI2.TotalPages
          Debug.Print "Size of Job In Bytes" & vbTab & JI2.Size
          'Because of a bug in Windows NT 3.51, the time member is not set correctly.
          'Therefore, do not use the time member on Windows NT 3.51.
          Debug.Print "Elapsed Print Time" & vbTab & JI2.time
          Debug.Print "Pages Printed So Far" & vbTab & JI2.PagesPrinted

          'Display basic job status info.
          JobStr = JobStr & "Job ID = " & JI2.JobId & _
            vbCrLf & "Total Pages = " & JI2.TotalPages & vbCrLf

          tempStr = ""  'Clear
          'Check for a ready state.
          If JI2.pStatus = 0& Then  ' If pStatus is Null, check Status.
            If JI2.Status = 0 Then
              tempStr = tempStr & "Ready!  " & vbCrLf
            Else  'Check for the various print job states.
              If (JI2.Status And JOB_STATUS_SPOOLING) Then
                  tempStr = tempStr & "Spooling  "
              End If

              If (JI2.Status And JOB_STATUS_OFFLINE) Then
                  tempStr = tempStr & "Off line  "
              End If

              If (JI2.Status And JOB_STATUS_PAUSED) Then
                  tempStr = tempStr & "Paused  "
              End If

              If (JI2.Status And JOB_STATUS_ERROR) Then
                  tempStr = tempStr & "Error  "
              End If

              If (JI2.Status And JOB_STATUS_PAPEROUT) Then
                  tempStr = tempStr & "Paper Out  "
              End If

              If (JI2.Status And JOB_STATUS_PRINTING) Then
                  tempStr = tempStr & "Printing  "
              End If

              If (JI2.Status And JOB_STATUS_USER_INTERVENTION) Then
                  tempStr = tempStr & "User Intervention Needed  "
              End If

              If Len(tempStr) = 0 Then
                  tempStr = "Unknown Status of " & JI2.Status
              End If
            End If
        Else
            ' Dereference pStatus.
            tempStr = PtrCtoVbString(JI2.pStatus)
        End If

          'Report the Job status.
          JobStr = JobStr & tempStr & vbCrLf
          Debug.Print JobStr & tempStr
      Next I
  End If

  'Close the printer handle.
  ClosePrinter hPrinter
End Function

Paulo
O meu Office é 32.
Vou testar quando chegar a casa.
Obrigado

Fiz aqui o teste e realmente funfa.

Apenas um senão;
O código vai buscar a sua impressora que está setada como "Default".

Se pretender saber o satus de outra impressora, terá de alterar este trecho;

Código:

  'NOME DA SUA IMPRESSORA, SE ESTIVER NUM SERVIDOR TEM DE INICIAR POR \\ CAMINHO + NOME
  PrinterName = "\\Meuservidor\minhaLexmark" 'Printer.DeviceName


JPaulo

Ligada ou desligada sempre a mesma informação.

up

Up

up

Assis, já testou em diversas máquinas pra ver se em alguma funciona e tentar daí detectar o que pode estar acontecendo?

Bom dia Ivan

Tenho 3 computadores em casa todos com impressora HP, mas diferente modelos.

A única situação que é idêntica é o software em todos os 3 PC.

Windows 10 Home, Office 2013.

Obrigado