• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 336
  • Last Modified:

VB 6.0 and print a word document

hello to everybody!
i have a question subject vb 6.0 and printing a word document over the commondialog with a network printer.

here my code:

Option Explicit

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DMDUP_SIMPLEX = 1
Private Const DM_DUPLEX = &H1000&
Private Const DM_ORIENTATION = &H1&
Private Const DM_MODIFY = 8
Private Const DM_COPY = 2

Private Type DOC_INFO_1
   pDocName As String
   pOutputFile As String
   pDatatype As String
End Type

Private 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
    dmICMMethod As Long        ' // Windows 95 only
    dmICMIntent As Long        ' // Windows 95 only
    dmMediaType As Long        ' // Windows 95 only
    dmDitherType As Long       ' // Windows 95 only
    dmReserved1 As Long        ' // Windows 95 only
    dmReserved2 As Long        ' // Windows 95 only
End Type

    pDatatype As String
    pDevMode As Long
    DesiredAccess As Long
End Type

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

Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _
   "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
   pDocInfo As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" _
   (ByVal hPrinter As Long) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" _
   (ByVal hPrinter 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (hpvDest As Any, hpvSource As Any, ByVal cbCopy 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 Any, ByVal pDevModeInput As Any, ByVal fMode 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 Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

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

Private bJobStarted As Boolean
Private PrinterName As String
Private PrinterHandle As Long
Private lJob As Long
Private lBytesWritten As Long
Private lBytesSent As Long

Const DC_BINS = 6
Const DC_BINNAMES = 12

Dim BinFirstPage As Long
Dim BinNextPage As Long

Private Sub cmdChangePrinterOrient_Click()
    bJobStarted = False
    CommonDialog1.Orientation = cdlLandscape
    CommonDialog1.Copies = 2
    PrinterName = Printer.DeviceName
    If PrinterName = "" Then
        Exit Sub
    End If
    Call NewDoc
    Call SetOrientation(DMDUP_SIMPLEX, CommonDialog1.Orientation, Me)
    ShellExecute Me.hwnd, "PRINT", "D:\Test\Test.doc", vbNullString, vbNullString, ByVal -1
End Sub

Private Sub NewDoc()
   Dim di As DOC_INFO_1
   If bJobStarted Then
      Exit Sub
   End If
   OpenPrinter PrinterName, PrinterHandle, ByVal 0&
   di.pDocName = vbNullChar
   di.pOutputFile = vbNullChar
   di.pDatatype = "RAW" & vbNullChar
   lJob = StartDocPrinter(PrinterHandle, 1, di)
   If lJob <= 0 Then
      Call ClosePrinter(PrinterHandle)
      Exit Sub
   End If
   StartPagePrinter PrinterHandle
   lBytesWritten = 0
   lBytesSent = 0
   bJobStarted = True
End Sub

Private Sub SetOrientation(NewSetting As Long, chng As Integer, ByVal frm As Form)
    Dim Needed As Long
    Dim pi2_buffer() As Long
    Dim MyDevMode As DEVMODE
    Dim Result As Long
    Dim pFullDevMode As Long
    Result = GetPrinter(PrinterHandle, 2, ByVal 0&, 0, Needed)
    ReDim pi2_buffer((Needed \ 4))
    Result = GetPrinter(PrinterHandle, 2, pi2_buffer(0), Needed, Needed)
    pFullDevMode = pi2_buffer(7)
    Call CopyMemory(MyDevMode, ByVal pFullDevMode, Len(MyDevMode))
    MyDevMode.dmDuplex = NewSetting
    MyDevMode.dmFields = DM_DUPLEX Or DM_ORIENTATION
    MyDevMode.dmOrientation = chng
    Call CopyMemory(ByVal pFullDevMode, MyDevMode, Len(MyDevMode))
    Result = DocumentProperties(frm.hwnd, PrinterHandle, PrinterName, ByVal pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
    Result = SetPrinter(PrinterHandle, 2, pi2_buffer(0), 0&)
    Call ClosePrinter(PrinterHandle)
    Printer.Duplex = MyDevMode.dmDuplex
End Sub

Ok the "doc" will printed but only in portrait modus. the commondialog get the landscape modus and number of copies.
what is wrong?
many thanks and greetings from germany

  • 2
1 Solution
Mostly you need this:

Public Function SetPrinterDuplex(ByVal sPrinterName As String, _

       ByVal nDuplexSetting As Long) As Boolean

      Dim hPrinter As Long
      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."
            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)), _

      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)

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

   End Function


Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now