Problem with execution order in print routine

[Mark van Bree]

Hi all,

I am building a custom print macro in Word2003. Below the code I have now:
Sub BestandAfdrukken()
Dim lAntwoord As Long
Dim i, j As Integer
Dim intDuplex As Long
Dim strPrintResult As String

With Dialogs(wdDialogFilePrint)
lAntwoord = .Display
If Abs(lAntwoord) = vbOK Then
ActivePrinter = .Printer
intDuplex = mPrinterAPI.GetDuplex
If MsgBox("Print single sided?", vbYesNo, "Enkelzijdig") = vbYes
Then
SetPrinterDuplex PrinterNaam, 1
End If
.Execute
For j = 1 To 10
strPrintResult = IsJobPrinted(PrinterNaam,
ActiveDocument.name)
Select Case strPrintResult
Case "Ready" ', "Printing", "Spooling"
'Job wordt afgedrukt. Uit for en settings weer
terugzetten
Exit For
Case Else
Sleep (500)
End Select
Next
MsgBox "Is the doc printed?"
SetPrinterDuplex PrinterNaam, intDuplex
End If
End With

End Sub

There are several API calls to winspool.drv. These all work fine. When I use
the debugger while printing a document using this code everything is OK. When
the debugger hits the .Execute line the document is printed. After that I
have to reset the duplex setting to it's original state. Using single
stepping, this works fine.

Now... When I print without single stepping, the document doesn't print
until I click OK on the messagebox. Problem is that whatever I do, I can't
get the document to use the duplex setting I specify in the code. It looks
like when not single stepping the printersetting is returned to it's original
before the job actually gets sent to the printer.

Any ideas?

Thanks in advance...


Mark van Bree

 

[Jean-Guy Marcil]

:

It looks as though you are relying on the .Execute line to do the printing.
Have you tried using the .PrintOut method instead?

Also, two very minor comments on your code.

Dim i, j As Integer
actually declares j as Integer and i as Variant.
You need
Dim i As Integer, j As Integer
or
Dim i As Integer
Dim j As Integer

Also, with today's machines, Integer is not actually used anymore by the VB
engine. The smallest unit of allocatable memory is a Long.
So, when you use an Integer, the compiler has to do some work to allocate it
to a Long space in memory. So, might as well use a Long...

 

[Mark van Bree]

Thanks for your reply...

I tried the ActiveDocument.Printout method. The print dialog doesn't support
the .Printout method. Unfortunately it doesn't solve the problem. I still
can't control if a document gets printed single-sided or duplex.

 

[Chip Orange]

Mark,

How about showing us your duplexing routines?

Chip

 

[Mark van Bree]

Hi Chip,

The duplex code I am using:
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 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)

' ==================================================================
' SetPrinterDuplex
'
' Programmatically set the Duplex flag for the specified printer
' driver's default properties.
'
' 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.
'
' nDuplexSetting - One of the following standard settings:
' 1 = None
' 2 = Duplex on long edge (book)
' 3 = Duplex on short edge (legal)
'
' ==================================================================
Public Function SetPrinterDuplex(ByVal sPrinterName As String, _
ByVal nDuplexSetting 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 (nDuplexSetting < 1) Or (nDuplexSetting > 3) Then
MsgBox "Error: dwDuplexSetting is incorrect."
Exit Function
End If

pd.DesiredAccess = PRINTER_ALL_ACCESS
nRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (nRet = 0) Or (hPrinter = 0) Then
If Err.LastDllError = 5 Then
MsgBox "Access denied -- See the article 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 And 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.dmDuplex = nDuplexSetting
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 duplex 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))

nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
If (nRet = 0) Then
MsgBox "Unable to set shared printer settings."
End If

SetPrinterDuplex = CBool(nRet)

cleanup:
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function

 

[Chip Orange]

Hi Mark,

Well, we're doing something very similar, obviously based on the same kb
article and vba code found somewhere on the web, and ours is working all the
time.

In the code which actually sets the duplexing property I see we're using a
different level of access for the printer object (we're using Access_Use),
and we've got various short delays which I've found to be necessary to give
the printer driver time to implement the requested settings. So, I'll post
our code for duplexing a document below in case you want to study it for
differences. There are parts you will need to remove before you can use it
(parts specific to our network printing). They're pretty obvious. Also, I
see we're only working with the windows default printer; I'm not sure if you
are making the printer you're printing to the default printer before using
it, and I'm not sure if it's necessary, but I thought I'd mention it.


Option Explicit

' printer routines
' code taken from a web article and slightly modified to work with PSC
network printing.




' ------ used by printer functions -------

Private Const DM_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2
Private Const DM_PAPERLENGTH = &H4
Private Const DM_PAPERWIDTH = &H8
Private Const DM_DEFAULTSOURCE = &H200
Private Const DM_PRINTQUALITY = &H400
Private Const DM_COLOR = &H800
Private Const DM_DUPLEX = &H1000

Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2
Private Const PRINTER_ACCESS_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_NORMAL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_USE)

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2


Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevmode As Long
DesiredAccess As Long
End Type

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 ' 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

Private 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

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Private 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
Private 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
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long
Private 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
Private Declare Function EnumPrinters Lib "winspool.drv" _
Alias "EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal cbLength As Long)

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As Long

' -----------
' ---------------------- printing functions -----------------



Public Sub SetColorMode(iColorMode As Long)
SetPrinterProperty DM_COLOR, iColorMode
End Sub

Public Function GetColorMode() As Long
GetColorMode = GetPrinterProperty(DM_COLOR)
End Function

Public Sub SetDuplex(iDuplex As Long)

'Value Meaning
' 1 Single-sided printing
'2 Duplex printing using a vertical binding (book flip left left)
'3 Duplex printing using a horizontal binding (tablet flip up)
'
' Note from Chip: some printers change the meaning of the above constants to
agree with the direction of the printing, and some do not.
'
Dim strPrinterDesignation As String
Dim strBizHubs As String
Dim strHP5s As String
Dim strHP4350s As String
Dim strDells As String
Dim strCanons As String
Dim blnIsLandscape As Boolean

If iDuplex < 1 Or iDuplex > 3 Then
Call SendMail("corange", "invalid parameter of " & iDuplex & " in
SetDuplex() from template " & ActiveDocument.AttachedTemplate, _
"Library.dot error")
MsgBox "invalid parameter of " & iDuplex & " in SetDuplex() from template "
& ActiveDocument.AttachedTemplate, _
vbOKOnly + vbCritical, "Library.dot Error"
Exit Sub
End If


strPrinterDesignation = Mid(UCase(ActivePrinter), 7, 3) ' assumes a network
server name 3 chars in length
If iDuplex = 1 Then
' returning to normal.
Else
' setting it to a duplexing option
strCanons = "E1R, E11, E12, E13, G11, G12, G13, G31, G32, G33"
strBizHubs = "G14, G34"
strHP5s = "G2G, G3G, G3L, G3Z"
strHP4350s = "G35,G1B, G2M, G1O, G3A,
G3E,E1B,G1H,G2H,G2V,G1I,G2E,G3N,G3D,E1K,G1Z"
strDells = "G1X,G1Y"
' Determine if it is landscape
' This is done to get around inconsistancies between printer drivers in how
duplexing is implemented for landscape printing.
' This scheme however will not work properly for documents which have
multiple sections, where only some sections are landscaped.
' the orientation property (or anything in the PageSetup) cannot be accessed
if the document (form) is protected, so unprotect it if necessary.
Dim lngProtect As Long
lngProtect = ActiveDocument.ProtectionType
If lngProtect <> wdNoProtection Then
ActiveDocument.Unprotect
End If
blnIsLandscape = (ActiveDocument.PageSetup.Orientation = wdOrientLandscape)
If lngProtect <> wdNoProtection Then
ActiveDocument.Protect Type:=lngProtect, noreset:=True
End If
'
If (InStr(UCase(strHP4350s & strHP5s & strBizHubs & strCanons & strDells),
strPrinterDesignation) > 0) _
And blnIsLandscape Then
' this is a type of printer which reverses the meaning of the duplexing
parameter when printing landscape (so it agrees with the direction of the
print), so "unreverse" it.
' This allows programmers to always be able to count on duplexing around a
certain edge of the paper regardless of the print orientation.
If iDuplex = 2 Then
iDuplex = 3
Else
iDuplex = 2
End If
End If ' in list of printers and is landscape
End If ' iDuplex = 1
'
Call SetPrinterProperty(DM_DUPLEX, iDuplex)

End Sub

Public Function GetDuplex() As Long
Dim I As Integer

GetDuplex = 1
I = GetPrinterProperty(DM_DUPLEX)
' this isn't exactly working properly because of the exception made for some
printers when printing landscape.
' it needs to reverse the exception.
If I > 0 And I < 4 Then GetDuplex = I
End Function

Public Sub SetPrintQuality(iQuality As Long)
SetPrinterProperty DM_PRINTQUALITY, iQuality
End Sub

Public Function GetPrintQuality() As Long
GetPrintQuality = GetPrinterProperty(DM_PRINTQUALITY)
End Function

Private Function SetPrinterProperty(ByVal iPropertyType As Long, _
ByVal iPropertyValue As Long) As Boolean

'Code adapted from Microsoft KB article Q230743

Dim hPrinter As Long 'handle for the current printer
Dim pd As PRINTER_DEFAULTS
Dim pinfo As PRINTER_INFO_2
Dim dm As DEVMODE
Dim sPrinterName As String

Dim yDevModeData() As Byte 'Byte array to hold contents
' of DEVMODE structure
Dim yPInfoMemory() As Byte 'Byte array to hold contents
' of PRINTER_INFO_2 structure
Dim iBytesNeeded As Long
Dim iRet As Long
Dim iJunk As Long
Dim iCount As Long

Sleep (10)

' temporary
' On Error GoTo cleanup

SetPrinterProperty = False
'Get the name of the current printer
If Trim(ActivePrinter) = "" Then
' no printer selected
Exit Function
End If

sPrinterName = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))

' pd.DesiredAccess = PRINTER_NORMAL_ACCESS
pd.DesiredAccess = PRINTER_ACCESS_USE
iRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (iRet = 0) Or (hPrinter = 0) Then
Call Sleep(10) ' wait for driver to finish loading and try again
iRet = OpenPrinter(sPrinterName, hPrinter, pd)
End If
If (iRet = 0) Or (hPrinter = 0) Then
'Can't access current printer. Bail out doing nothing
Call SendMail("corange", "Unexpectedly could not Open printer information
for printer " & sPrinterName & ", in Function SetPrinterProperty(), ", _
"library.dot error")
MsgBox "Unexpectedly could not Open printer information for printer " &
sPrinterName & ", in Function SetPrinterProperty(), please notify ITS", _
vbOKOnly + vbCritical, "Word Library.dot"
Exit Function
End If

'Get the size of the DEVMODE structure to be loaded
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (iRet < 0) Then
Call Sleep(10) ' wait for driver to finish loading and try again
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
End If
If (iRet < 0) Then
' Can't access printer properties.
Call SendMail("corange", "Unexpectedly could not access printer property
information for printer " & sPrinterName & ", in Function
SetPrinterProperty()", _
"library.dot error")
MsgBox "Unexpectedly could not access printer property information for
printer " & sPrinterName & ", in Function SetPrinterProperty(), please
notify ITS", _
vbOKOnly + vbCritical, "Word Library.dot"
GoTo Cleanup
End If

'Make sure the byte array is large enough 'Some printer drivers lie about
the size of the DEVMODE structure they 'return, so an extra 100 bytes is
provided just in case!
ReDim yDevModeData(0 To iRet + 100) As Byte

' Load the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
Call Sleep(10) ' wait for driver to finish loading and try again
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
End If
If (iRet < 0) Then
Call SendMail("corange", "Unexpectedly could not access printer property
information(#2) for printer " & sPrinterName & ", in Function
SetPrinterProperty()", _
"library.dot error")
MsgBox "Unexpectedly could not access printer property information(#2) for
printer " & sPrinterName & ", in Function SetPrinterProperty(), please
notify ITS", _
vbOKOnly + vbCritical, "Word Library.dot"
GoTo Cleanup
End If

' Copy the byte array into a structure so it can be manipulated
Call CopyMemory(dm, yDevModeData(0), Len(dm))

If dm.dmFields And iPropertyType = 0 Then
' Wanted property not available. Bail out.
Call SendMail("corange", _
"Unexpectedly could not access printer property type for printer " &
sPrinterName & ", in Function SetPrinterProperty()", _
"library.dot error")
' don't show error for now.
' MsgBox "Unexpectedly could not access printer property type for printer "
& sPrinterName & ", in Function SetPrinterProperty(), please notify ITS", _
' vbOKOnly + vbCritical, "Word Library.dot"
GoTo Cleanup
End If

' Set the property to the appropriate value
Select Case iPropertyType
Case DM_ORIENTATION
dm.dmOrientation = iPropertyValue
Case DM_PAPERSIZE
dm.dmPaperSize = iPropertyValue
Case DM_PAPERLENGTH
dm.dmPaperLength = iPropertyValue
Case DM_PAPERWIDTH
dm.dmPaperWidth = iPropertyValue
Case DM_DEFAULTSOURCE
dm.dmDefaultSource = iPropertyValue
Case DM_PRINTQUALITY
dm.dmPrintQuality = iPropertyValue
Case DM_COLOR
dm.dmColor = iPropertyValue
Case DM_DUPLEX
dm.dmDuplex = iPropertyValue
End Select

' Load the structure back into the byte array
Call CopyMemory(yDevModeData(0), dm, Len(dm))

' Tell the printer about the new property
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
DM_IN_BUFFER Or DM_OUT_BUFFER)

Sleep (10)


If (iRet < 0) Then
MsgBox "Unexpectedly could not Set printer property information for printer
" & sPrinterName & ", in Function SetPrinterProperty(), please notify ITS",
_
vbOKOnly + vbCritical, "Word Library.dot"
GoTo Cleanup
End If

' The code above *ought* to be sufficient to set the property 'correctly.
Unfortunately some
' brands of Postscript printer don't 'seem to respond correctly. The
following code is used to
' make sure they also respond correctly.
Call GetPrinter(hPrinter, 2, 0, 0, iBytesNeeded)
If (iBytesNeeded = 0) Then
' Couldn't access shared printer settings
MsgBox "Unexpectedly could not access shared printer settings for printer "
& sPrinterName & ", in Function SetPrinterProperty(), please notify ITS", _
vbOKOnly + vbCritical, "Word Library.dot"
GoTo Cleanup
End If

' Set byte array large enough for PRINTER_INFO_2 structure
ReDim yPInfoMemory(0 To iBytesNeeded + 100) As Byte

' Load the PRINTER_INFO_2 structure into byte array
iRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), iBytesNeeded, iJunk)
If (iRet = 0) Then
' Couldn't access shared printer settings
MsgBox "Unexpectedly could not access shared printer settings(#2) for
printer " & sPrinterName & ", in Function SetPrinterProperty(), please
notify ITS", _
vbOKOnly + vbCritical, "Word Library.dot"
GoTo Cleanup
End If

' Copy byte array into the structured type
Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))

' Load the DEVMODE structure with byte array containing
' the new property value
pinfo.pDevmode = VarPtr(yDevModeData(0))

' Set security descriptor to null
pinfo.pSecurityDescriptor = 0

' Copy the PRINTER_INFO_2 structure back into byte array
Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

' Send the new details to the printer
iRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)

Sleep (10)

If (iRet = 0) Then
' Couldn't set shared printer settings
Call SendMail("corange", _
"Unexpectedly could not set shared printer settings(#2) for printer " &
sPrinterName & ", in Function SetPrinterProperty()", _
"Library.dot error")

' MsgBox "Unexpectedly could not set shared printer settings(#2) for printer
" & sPrinterName & ", in Function SetPrinterProperty(), please notify ITS",
_
' vbOKOnly + vbCritical, "Word Library.dot"
End If
' Indicate whether it all worked or not!
SetPrinterProperty = CBool(iRet)

Cleanup:
' Release the printer handle
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)
Sleep (10)

End Function




Private Function GetPrinterProperty(ByVal iPropertyType As Long) As Long

' Code adapted from Microsoft KB article Q230743

Dim hPrinter As Long
Dim pd As PRINTER_DEFAULTS
Dim dm As DEVMODE
Dim sPrinterName As String

Dim yDevModeData() As Byte
Dim iRet As Long

' On Error GoTo cleanup

' Get the name of the current printer
sPrinterName = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))

pd.DesiredAccess = PRINTER_ACCESS_USE

GetPrinterProperty = 0

' Get the printer handle
iRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (iRet = 0) Or (hPrinter = 0) Then
' Couldn't access the printer
Call SendMail("corange", "Unable to access printer data in library function
GetPrinterProperty() #1", _
"library.dot error")

MsgBox "Unable to access printer data in library function
GetPrinterProperty()", _
"Error", vbOKOnly + vbCritical

Exit Function
End If

' Find out how many bytes needed for the printer properties
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (iRet < 0) Then
' Couldn't access printer properties
Call SendMail("corange", "Unable to access printer data in library function
GetPrinterProperty() #2", _
"library.dot error")
MsgBox "Unable to access printer data in library function
GetPrinterProperty()", _
"Error", vbOKOnly + vbCritical
GoTo Cleanup
End If

' Make sure the byte array is large enough, including the
' 100 bytes extra in case the printer driver is lying.
ReDim yDevModeData(0 To iRet + 100) As Byte

' Load the printer properties into the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
' Couldn't access printer properties
Call SendMail("corange", "Unable to access printer data in library function
GetPrinterProperty() #3", _
"library.dot error")
MsgBox "Unable to access printer data in library function
GetPrinterProperty()", _
"Error", vbOKOnly + vbCritical
GoTo Cleanup
End If

' Copy the byte array to the DEVMODE structure
Call CopyMemory(dm, yDevModeData(0), Len(dm))

If Not dm.dmFields And iPropertyType = 0 Then
' Requested property not available on this printer.
Call SendMail("corange", "Unable to access printer data in library function
GetPrinterProperty() #4, Requested property not available on this printer.",
_
"library.dot error")
MsgBox "Unable to access printer data in library function
GetPrinterProperty() #4, Requested property not available on this printer.",
_
"Error", vbOKOnly + vbCritical
GoTo Cleanup
End If

' Get the value of the requested property
Select Case iPropertyType
Case DM_ORIENTATION
GetPrinterProperty = dm.dmOrientation
Case DM_PAPERSIZE
GetPrinterProperty = dm.dmPaperSize
Case DM_PAPERLENGTH
GetPrinterProperty = dm.dmPaperLength
Case DM_PAPERWIDTH
GetPrinterProperty = dm.dmPaperWidth
Case DM_DEFAULTSOURCE
GetPrinterProperty = dm.dmDefaultSource
Case DM_PRINTQUALITY
GetPrinterProperty = dm.dmPrintQuality
Case DM_COLOR
GetPrinterProperty = dm.dmColor
Case DM_DUPLEX
GetPrinterProperty = dm.dmDuplex
End Select

Cleanup:
'Release the printer handle
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function

' -----------------------------

 

[Jean-Guy Marcil]

Thanks for your reply...

I tried the ActiveDocument.Printout method. The print dialog doesn't support
the .Printout method. Unfortunately it doesn't solve the problem. I still
can't control if a document gets printed single-sided or duplex.

I meant, use whatever technique you are already using to set up the
duplexing parameters (That part seems to work).
Then, leave the dialog and use the .PrintOut method on a document object.

 

[Mark van Bree]

Hi Chip,

Thanks for your code sample and sorry for the late response. I could not get
to the printer due to holliday.

I have tried your code and unfortunately I get the same problem with your
code as I got with the code I already had.

I removed some of your specific code and tested my solution with your duplex
code. I found out that the duplex setting I set is effective on the next
printjob. So, the duplex code does what it supposed to do, but on the next
time I print the document.

So I think that the problem is not in the code to set the duplex value, but
in the code that calls these routines. The code below is what I use:

Sub BestandAfdrukkenStripped()
Dim lAntwoord As Long
Dim i, j, intEnkelzijdig As Integer
Dim intDuplex As Long
Dim strPrintResult As String

On Error GoTo Foutafhandeling
With Dialogs(wdDialogFilePrint)
lAntwoord = .Display
If Abs(lAntwoord) = vbOK Then
ActivePrinter = .printer
intDuplex = mPrinterAPI.GetDuplex
'MsgBox "intDuplex = " & intDuplex
intEnkelzijdig = MsgBox("Print single sided?", vbQuestion +
vbYesNo, "Print")
If intEnkelzijdig = vbYes Then
modChip.SetDuplex 1
Else
modChip.SetDuplex 2
End If
intDuplex = mPrinterAPI.GetDuplex
MsgBox "Your document is printed " & intDuplex
.Execute
End If
End With
Exit Sub

Foutafhandeling:
Fout Err.Number, Err.Description
End Sub

This code is working now. Except when I remove the "Your document is
printed" messagebox the code does not work anymore. I tried to replace it
with sleep(500), but that wouldn't work either. This remains a strange
problem...

What code do you use to call the printer procedures? Are you also working
with the printdialog?


Kind regards,

Mark

 

[Chip Orange]

Hi Mark,

I found the only effective way for my code to work was to change the duplex
setting *before* i invoked the print dialog. In my case, I knew based on
the situation whether the user needed it to print duplex or not.

While you tried sleep 500, I believe there is some value of sleep which must
work for you, as the MsgBox command is working. So, if you must have the
question after the dialog, try increasing sleep to higher values to see if
that helps.

hth,

Chip