VB 6.0 and print a word document

Posted on 2004-08-06
Last Modified: 2008-01-09
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

Question by:BraveNewWorld
  • 2

Accepted Solution

computerg33k earned 500 total points
Comment Utility

Expert Comment

Comment Utility
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
If you’re thinking to yourself “That description sounds a lot like two people doing the work that one could accomplish,” you’re not alone.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now