VBA print tray script help

[Fyr]

I am using the script below to set a specific printer tray. I can not tell if it actually works because the printer keeps getting disconnected at the end of the script. I will highlight the line where it disconnects in red.

Any ideas what the problem is?

Option Explicit
 Public Type PRINTER_DEFAULTS
 pDatatype As Long
 pDevmode As Long
 DesiredAccess As Long
 End Type
 
Public Type PRINTER_INFO_9
 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)
 
 Private Const WM_SETTINGCHANGE = &H1A
 Private Const SMTO_NORMAL = &H0
 
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 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)
 
 ' ==================================================================
 ' 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, Optional bSet As Boolean) As Boolean
 
Dim hPrinter As Long
 Dim pd As PRINTER_DEFAULTS
 Dim pinfo As PRINTER_INFO_9
 Dim dm As DEVMODE
 Dim yDevModeData() As Byte
 Dim yPInfoMemory() As Byte
 Dim nBytesNeeded As Long
 Dim nRet As Long, nJunk As Long
 
Dim Res As Long
Dim hwndApp As Long
Const C_MAIN_WINDOW_CLASS = "XLMAIN"

 On Error GoTo cleanup
 If (nBinSetting < 1) Or (nBinSetting > 11) Then
 MsgBox "Error: Tray Setting is incorrect."
 Exit Function
 End If
 pd.DesiredAccess = PRINTER_ACCESS_USE
 nRet = OpenPrinter(sPrinterName, hPrinter, 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
 If Not CBool(dm.dmFields) 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))
[COLOR=#ff0000][B] nRet = SetPrinter(hPrinter, 9, yPInfoMemory(0), 0)[/B][/COLOR]
 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
 
Sub TestSetting()
 ' This routine tests SetPrinterTray, using it to set the Manual
 ' input paper tray as the default paper source
 
Dim Success As Boolean
 Success = SetPrinterTray("[URL="file://\\printserver\DDPD-12"]\\printserver\DDPD-12[/URL]", 3)
 If Success Then
 MsgBox "Glorious Success!"
 Else
 MsgBox "Miserable Failure!"
 End If
 End Sub

 

[Fyr]

bumpo