I've been working on this for the last few hours and I can't seem to get it working properly. Any advice would be appreciated.
I'm trying to get Excel(2003) to print (through XP platform) to a shared network printer but select the paper source (tray) at the same time. In Excel this seems particularly difficult - in Word its much easier. The printer is set up as default "auto" paper source but I want to use the manual paper feed instead for that print job only.
Below is my code so far (I can't take the credit because most came from the microsft support site). The code runs without error the first time but does not change the paper source. The second time you run it fails with "Unable to set shared printer settings" - resetting the printer preferences through Windows to "restore defaults" allows the code to run again but not change the tray. Any ideas on why, this has me stumped, my API knowledge is very limited ?
I'm trying to get Excel(2003) to print (through XP platform) to a shared network printer but select the paper source (tray) at the same time. In Excel this seems particularly difficult - in Word its much easier. The printer is set up as default "auto" paper source but I want to use the manual paper feed instead for that print job only.
Below is my code so far (I can't take the credit because most came from the microsft support site). The code runs without error the first time but does not change the paper source. The second time you run it fails with "Unable to set shared printer settings" - resetting the printer preferences through Windows to "restore defaults" allows the code to run again but not change the tray. Any ideas on why, this has me stumped, my API knowledge is very limited ?
Code:
Option Explicit
Public Type PRINTER_DEFAULTS
pDatatype As Long
pDevmode As Long
DesiredAccess As Long
End Type
Public 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 ' Pointer to DEVMODE
pSepFile As Long
pPrintProcessor As Long
pDatatype As Long
pParameters As Long
pSecurityDescriptor As Long ' Pointer to 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 Type DEVMODE
dmDeviceName As String * 32
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 * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
End Type
Public Const DM_DUPLEX = &H1000&
Public Const DM_IN_BUFFER = 8
Public Const DM_OUT_BUFFER = 2
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Public Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
ByVal hPrinter As Long, ByVal pDeviceName As String, _
ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
ByVal fMode As Long) 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 OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As Any) As Long
'pDefault As PRINTER_DEFAULTS) As Long
Public Declare Function SetPrinter Lib "winspool.drv" Alias _
"SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal Command As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal cbLength As Long)
Sub dummy_print()
Dim my_printer_address As String, my_printer_name As String, success As Boolean
my_printer_address = Application.Dialogs(xlDialogPrinterSetup).Show 'display printer list for selection
If (my_printer_address = False) Then Exit Sub 'terminate early cause user has cancelled
my_printer_name = Left(Application.ActivePrinter, InStr(Application.ActivePrinter, " on ") - 1) 'slice string for printer name (minus port name)
success = SetPrinterTray(my_printer_name, 4)
If Not success Then
MsgBox "Error trying to change paper tray"
Exit Sub
End If
Worksheets("Sheet1").Activate
Range("A1:D12").Select
Selection.PrintOut Copies:=1
End Sub
' ==================================================================
' SetPrinterTray
'
' Programmatically set the input source flag for the specified printer
' driver's default properties for paper input bin.
'
' Returns: True on success, False on error. (An error will also
' display a message box. This is done for informational value
' only. You should modify the code to support better error
' handling in your production application.)
'
' Parameters:
' sPrinterName - The name of the printer to be used.
'
' nBinSetting - One of the following standard settings:
' 1 = Upper
' 2 = Lower
' 3 = Middle
' 4 = Manual
' 5 = Envelope
' 6 = Envelope Manual
' 7 = Auto
' 8 = Tractor
' 9 = Small Format
' 10 = Large Format
' 11 = Large Capacity
'
' ==================================================================
Public Function SetPrinterTray(ByVal sPrinterName As String, _
ByVal nBinSetting As Long) As Boolean
Dim hPrinter As Long
Dim pd As PRINTER_DEFAULTS
Dim pinfo As PRINTER_INFO_2
Dim dm As DEVMODE
Dim yDevModeData() As Byte
Dim ypinfoMemory() As Byte
Dim nBytesNeeded As Long
Dim nRet As Long, nJunk As Long
On Error GoTo cleanup
If (nBinSetting < 1) Or (nBinSetting > 11) Then
MsgBox "Error: Tray Setting is incorrect."
Exit Function
End If
pd.DesiredAccess = PRINTER_ALL_ACCESS
nRet = OpenPrinter(sPrinterName, hPrinter, ByVal 0&) 'pd)
If (nRet = 0) Or (hPrinter = 0) Then
If Err.LastDllError = 5 Then
MsgBox "Access denied -- See article Q230743 for more info."
Else
MsgBox "Cannot open the printer specified " & _
"(make sure the printer name is correct)."
End If
Exit Function
End If
nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (nRet < 0) Then
MsgBox "Cannot get the size of the DEVMODE structure."
GoTo cleanup
End If
ReDim yDevModeData(nRet + 100) As Byte
nRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (nRet < 0) Then
MsgBox "Cannot get the DEVMODE structure."
GoTo cleanup
End If
Call CopyMemory(dm, yDevModeData(0), Len(dm))
If Not CBool(dm.dmFields & DM_DUPLEX) Then
MsgBox "You cannot modify the duplex flag for this printer " & _
"because it does not support duplex or the driver " & _
"does not support setting it from the Windows API."
GoTo cleanup
End If
dm.dmDefaultSource = nBinSetting
Call CopyMemory(yDevModeData(0), dm, Len(dm))
nRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
DM_IN_BUFFER Or DM_OUT_BUFFER)
If (nRet < 0) Then
MsgBox "Unable to set tray setting to this printer."
GoTo cleanup
End If
Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
If (nBytesNeeded = 0) Then GoTo cleanup
ReDim ypinfoMemory(nBytesNeeded + 100) As Byte
nRet = GetPrinter(hPrinter, 2, ypinfoMemory(0), nBytesNeeded, nJunk)
If (nRet = 0) Then
MsgBox "Unable to get shared printer settings."
GoTo cleanup
End If
Call CopyMemory(pinfo, ypinfoMemory(0), Len(pinfo))
pinfo.pDevmode = VarPtr(yDevModeData(0))
pinfo.pSecurityDescriptor = 0
Call CopyMemory(ypinfoMemory(0), pinfo, Len(pinfo))
'Level 9 access is for current user profile (preferences). Level 2 access is for administration.
nRet = SetPrinter(hPrinter, 9, ypinfoMemory(0), 0)
If (nRet = 0) Then
MsgBox "Unable to set shared printer settings."
End If
SetPrinterTray = CBool(nRet)
cleanup:
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)
End Function
