Controlling the Printer from Word VBA

Part 4: Getting printer driver details

More Information Needed?
In the feedback section of this month's issue, Carol Baxter asked "It would be really useful to know how to capture the printer driver into a variable in word. I work for a large firm and all our network printers are called lp(then a number) so the active printer command will not tell me the name of the printer eg HP Laserjet 4. We have macros for printing."

Carol—this article is for you! (I hope that others will find it useful as well.)

Printer Information Available
The code provided with this article will allow you to get the following information about a printer.

• ServerName—the name of the printer server it is attached to (if any)
  
  
• ShareName—if the printer is shared, the share name as broadcast to the network
  
  
• PortName—the name of the port the printer is connected to
  
  
• DriverName—the name of the printer driver
  
  
• Comment—any comments that are listed for the printer in the Printer Properties dialog
  
  
• Location—the location as given in the Printer Properties dialog
  
  
• SepFile—the name of the file that defines the separator page for the printer (is an empty string if no separator file is defined)
  
  
• PrintProcessor—the name of the print processor for the printer
  
  
• Datatype—the format in which the printer files are spooled.
  
  
• Parameters—any parameters of the print processor command
  
  
• Status—the current status of the printer, e.g. "Ready", "Paused" etc.
  
  
• Jobs—the number of print jobs currently in the queue for the printer.
  

The DriverName is what Carol is after, but the other information might also be useful!

How to Use the Code
The code listed at the end of the article has a single routine, called GetPrinterDetails. It returns a user-defined type including all of the parameters I have described above. To find out the driver name of the current printer is as simple as this:

MsgBox "Driver name is " & _
     GetPrinterDetails.DriverName 

If you want to get several parameters in one go (to reduce the time spent making calls to the routine) and then use them later in your code, you can do something like this:

Dim pInfo as PrinterInfo
pInfo = GetPrinterDetails
MsgBox "Port name is " & pInfo.PortName
MsgBox "Printer status is " & pInfo.Status

Also, if you want to get the printer details for a printer other than the current printer, then you can do so, by including the printer name, like this:

MsgBox "HP DeskJet 540 status " & _
     GetPrinterDetails("HP DeskJet 540").Status

By the way, if you want to get a full list of the printers available on your system, this article by Astrid Zeelenberg tells you how.

Getting Names of Available Printers
http://www.mvps.org/word/FAQs/MacrosVBA/AvailablePrinters.htm

That article includes a routine that returns an array of the available printers. Any one of the items in that array can be used by the GetPrinterDetails routine.

Why Use the Code?
There are a number of possible reasons

• Carol's reason - you need to know the current printer type so that you can decide which printer tray to use for printing.
  
  
• You have several printers available, and want to check their status before printing - no point in printing to a printer that is paused or offline.
  
  
• You want to distribute print jobs among a number of printers, and want to find out which one is least heavily loaded.

An example of the second reason might work like this...

Suppose you have three printers (called Printer 1, Printer 2 and Printer 3) that you could use for printing the current job, and you want to be sure that you print to a printer that is ready, or will be reasonably soon. The following code could be used.

Dim PrinterList as Variant
Dim i as Long
Dim pInfo as PrinterInfo
PrinterList = Array("Printer 1", "Printer 2", "Printer 3")
For i = LBound(PrinterList) to UBound(PrinterList)
     pInfo = GetPrinterInfo(PrinterList(i))
     Select Case pInfo.Status
     Case "Ready", "Printing", "Processing Job", "Power Save Mode"
          ActivePrinter = PrinterList(i)
          ActiveDocument.PrintOut
          MsgBox "Job printed to " & PrinterList(i)
          Exit For
     Case Else
     End Select
Next i
If i > UBound(PrinterList) Then
     MsgBox "No printers are available at present"
End If

This code does checks each printer in turn, and if the status indicates that the printer is OK, it prints the job there and tells the user where to find the printout. Otherwise, it goes on to the next printer on the list. If no printers are available, it tells the user so.

Setting the ActivePrinter in Excel
I mainly do Word VBA, but I like to keep aware of uses for my code in the other Office applications. In this case, there is a particular use in Excel.

In Word, you can use just the printer name to set the ActivePrinter, even though the name doesn't include the port name. So something like this in Word will successfully change the printer.

ActivePrinter = "HP LaserJet 5Si"

If you try that code in Excel, you will get an error, because Excel must have the port name in the string that defines the printer. (Why this is needed by Excel and not Word is one of the mysteries of life!) This can be a bit of a nuisance if you have used Astrid's article (see above) to get a list of the available printers, as you can't then use it in Excel to set the printer. But with this routine, you can! Suppose the name of the printer you want is loaded into the variable NewPrinter. To change the printer in Excel, the following line of code will work fine.

ActivePrinter = NewPrinter & " on " & _
 	GetPrinterInfo(NewPrinter).PortName

Main Code for the Article
The following code should be pasted into a separate module.

Important Note! Same warning as usual. Unless you are confident you know what you are doing, don't alter this code, just use it. Bugs in Windows API code don't just stop a macro, they can bring down Word or even Windows.

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 SetPrinter Lib "winspool.drv" _
   Alias "SetPrinterA" (ByVal hPrinter As Long, _
   ByVal Level As Long, pPrinter As Any, _
   ByVal Command As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" (Destination As Any, _
   Source As Any, ByVal Length As Long)
   
Private Declare Function lstrlenA Lib "kernel32" _
   (ByVal lpString As Long) As Long

Private Declare Function FormatMessage Lib "kernel32" _
   Alias "FormatMessageA" (ByVal dwFlags As Long, _
   lpSource As Any, ByVal dwMessageId As Long, _
   ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
   ByVal nSize As Long, Arguments As Long) As Long

' The data area passed to a system call is too small.
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122

' Printer status flags used with PRINTER_INFORMATION_2
Private Const PRINTER_STATUS_READY As Long = &H0
Private Const PRINTER_STATUS_PAUSED As Long = &H1
Private Const PRINTER_STATUS_ERROR As Long = &H2
Private Const PRINTER_STATUS_PENDING_DELETION As Long = &H4
Private Const PRINTER_STATUS_PAPER_JAM As Long = &H8
Private Const PRINTER_STATUS_PAPER_OUT As Long = &H10
Private Const PRINTER_STATUS_MANUAL_FEED As Long = &H20
Private Const PRINTER_STATUS_PAPER_PROBLEM As Long = &H40
Private Const PRINTER_STATUS_OFFLINE As Long = &H80
Private Const PRINTER_STATUS_IO_ACTIVE As Long = &H100
Private Const PRINTER_STATUS_BUSY As Long = &H200
Private Const PRINTER_STATUS_PRINTING As Long = &H400
Private Const PRINTER_STATUS_OUTPUT_BIN_FULL As Long = &H800
Private Const PRINTER_STATUS_NOT_AVAILABLE As Long = &H1000
Private Const PRINTER_STATUS_WAITING As Long = &H2000
Private Const PRINTER_STATUS_PROCESSING As Long = &H4000
Private Const PRINTER_STATUS_INITIALIZING As Long = &H8000
Private Const PRINTER_STATUS_WARMING_UP As Long = &H10000
Private Const PRINTER_STATUS_TONER_LOW As Long = &H20000
Private Const PRINTER_STATUS_NO_TONER As Long = &H40000
Private Const PRINTER_STATUS_PAGE_PUNT As Long = &H80000
Private Const PRINTER_STATUS_USER_INTERVENTION As Long = &H100000
Private Const PRINTER_STATUS_OUT_OF_MEMORY As Long = &H200000
Private Const PRINTER_STATUS_DOOR_OPEN As Long = &H400000
Private Const PRINTER_STATUS_SERVER_UNKNOWN As Long = &H800000
Private Const PRINTER_STATUS_POWER_SAVE As Long = &H1000000

' Used to retrieve last API error text.
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000

' VBA-friendly structure used to return the printer info.
Public Type PrinterInfo
   ServerName As String
   ShareName As String
   PortName As String
   DriverName As String
   Comment As String
   Location As String
   SepFile As String
   PrintProcessor As String
   Datatype As String
   Parameters As String
   Status As String
   Jobs As Long
End Type

' Structure used to obtain the data from Windows.
Private 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 'DEVMODE
   pSepFile As Long
   pPrintProcessor As Long
   pDatatype As Long
   pParameters As Long
   pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
   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 Function GetPrinterDetails(Optional ByVal PrinterName As Variant) As PrinterInfo
   Dim pi2 As PRINTER_INFO_2
   Dim pi2_output As PrinterInfo
   Dim hPrn As Long
   Dim Buffer() As Byte
   Dim BytesNeeded As Long
   Dim BytesUsed As Long
   Dim slash As Long
   Dim DispName As String
   Dim PrinterErrorCode As Long
   Dim StatusCode As Long
   
   'Use default printer if none specified


   If IsMissing(PrinterName) Then
      PrinterName = ActivePrinter
      PrinterName = Left$(PrinterName, InStr(PrinterName, " on ") - 1)
   End If
   
   ' Get handle to printer.
   Call OpenPrinter(PrinterName, hPrn, ByVal 0&)
   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
            ' Fill local structure with data/pointers.
            Call CopyMemory(pi2, Buffer(0), Len(pi2))
            ' Transfer string data to output structure.
            pi2_output.ServerName = PointerToStringA(pi2.pServerName)
            pi2_output.ShareName = PointerToStringA(pi2.pShareName)
            pi2_output.PortName = PointerToStringA(pi2.pPortName)
            pi2_output.DriverName = PointerToStringA(pi2.pDriverName)
            pi2_output.Comment = PointerToStringA(pi2.pComment)
            pi2_output.Location = PointerToStringA(pi2.pLocation)
            pi2_output.SepFile = PointerToStringA(pi2.pSepFile)
            pi2_output.PrintProcessor = PointerToStringA(pi2.pPrintProcessor)
            pi2_output.Datatype = PointerToStringA(pi2.pDatatype)
            pi2_output.Parameters = PointerToStringA(pi2.pParameters)
            Call CopyMemory(StatusCode, Buffer(72), 4)
            Call CopyMemory(pi2_output.Jobs, Buffer(76), 4)
         End If
         PrinterErrorCode = 0 'clear error value
      Else
         PrinterErrorCode = Err.LastDllError
      End If
      pi2_output.Status = StatusText(StatusCode, PrinterErrorCode)
      Call ClosePrinter(hPrn)
   End If
   
   GetPrinterDetails = pi2_output
End Function

Private Function PointerToStringA(ByVal lpStringA As Long) As String
   Dim Buffer() As Byte
   Dim nLen As Long
   
   If lpStringA Then
      nLen = lstrlenA(ByVal lpStringA)
      If nLen Then
         ReDim Buffer(0 To (nLen - 1)) As Byte
         CopyMemory Buffer(0), ByVal lpStringA, nLen
         PointerToStringA = StrConv(Buffer, vbUnicode)
      End If
   End If
End Function

Private Function StatusText(StatusCode As Long, ErrorCode As Long) As String
   If ErrorCode Then
      StatusText = ApiErrorText(ErrorCode)
   Else
      Select Case StatusCode
         Case PRINTER_STATUS_READY
            StatusText = "Ready"
         Case PRINTER_STATUS_PAUSED
            StatusText = "Paused"
         Case PRINTER_STATUS_ERROR
            StatusText = "Error"
         Case PRINTER_STATUS_PENDING_DELETION
            StatusText = "Deleting..."
         Case PRINTER_STATUS_PAPER_JAM
            StatusText = "Paper Jam"
         Case PRINTER_STATUS_PAPER_OUT
            StatusText = "Paper Out"
         Case PRINTER_STATUS_MANUAL_FEED
            StatusText = "Manual Feed Required"
         Case PRINTER_STATUS_PAPER_PROBLEM
            StatusText = "Paper Problem"
         Case PRINTER_STATUS_OFFLINE
            StatusText = "Offline"
         Case PRINTER_STATUS_IO_ACTIVE
            StatusText = "Downloading Job"
         Case PRINTER_STATUS_BUSY
            StatusText = "Busy"
         Case PRINTER_STATUS_PRINTING
            StatusText = "Printing"
         Case PRINTER_STATUS_OUTPUT_BIN_FULL
            StatusText = "Output Bill Full"
         Case PRINTER_STATUS_NOT_AVAILABLE
            StatusText = "Not Available"
         Case PRINTER_STATUS_WAITING
            StatusText = "Waiting"
         Case PRINTER_STATUS_PROCESSING
            StatusText = "Processing Job"
         Case PRINTER_STATUS_INITIALIZING
            StatusText = "Initializing"
         Case PRINTER_STATUS_WARMING_UP
            StatusText = "Warming Up"
         Case PRINTER_STATUS_TONER_LOW
            StatusText = "Toner Low"
         Case PRINTER_STATUS_NO_TONER
            StatusText = "Toner Out"
         Case PRINTER_STATUS_PAGE_PUNT
            StatusText = "Page too Complex"
         Case PRINTER_STATUS_USER_INTERVENTION
            StatusText = "User Intervention Required"
         Case PRINTER_STATUS_OUT_OF_MEMORY
            StatusText = "Out of Memory"
         Case PRINTER_STATUS_DOOR_OPEN
            StatusText = "Door Open"
         Case PRINTER_STATUS_SERVER_UNKNOWN
            StatusText = "Unable to connect"
         Case PRINTER_STATUS_POWER_SAVE
            StatusText = "Power Save Mode"
         Case Else
            StatusText = Hex$(StatusCode)
      End Select
   End If
End Function

Private Function ApiErrorText(ByVal ErrNum As Long) As String
   Dim msg As String
   Dim nRet As Long

   msg = Space$(1024)
   nRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, ErrNum, 0&, msg, Len(msg), ByVal 0&)
   If nRet Then
      ApiErrorText = Left$(msg, nRet - 2) ' account for Cr/Lf
   Else
      ApiErrorText = "Error (" & ErrNum & ") not defined."
   End If
End Function

Library Code
I have provided a module which can be imported directly into your Word VBA project which includes all the routines described in all three parts of this article. Click here to download it.

Acknowledgements
I'm a great one for never writing Windows API code myself from scratch if I can avoid it. This month's article is no exception. The code here is adapted (with permission) from a very extensive set of VB class modules for printer information and control, written by Karl E. Peterson, VB/MVP. There's far too much code in his samples to be able to do it justice here, but you can see his original code at his site www.mvps.org/vb/. To see his printer sample code, click the Samples link on the left of the page, and then scroll down to the section PrnInfo.zip.

One thing I like about the samples on Karl's page is that he creates entire modules and class modules. If you have Office 2000 or later, this usually means you can import the code directly into your VBA project without modification, and the code just works. There's no development quite so rapid as being able to use somebody else's already tested and working code!

Note that you can't import forms (.frm modules) in this way because VB Forms are quite different from VBA UserForms.