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

Printing multiple pdf documents from Visual Basic without opening the documents

I want to be able to print multiple pdf files from within Visual Basic 6.0 without the user having to interact with the print dialog box.  I get the filepath and name of my pdf files from a recordset then I loop throught the recrodset to open the pdfs using a webbrowser object then use the ExecWB method to print.

I have two problems
1) I get the print dialog box which needs the user to actually click 'ok' to print.
 2) I get the following error message : Method ExecWeb of Object Iwebbrowser2 failed.

important considerations: I don't really want to open each pdf file.  I just want to print them from a directory that I have on my server.  

If there is a better way to do this please share it with me.  I'm wondering if there is a way to do this using crystal reports.

I'm attaching one of my pdf files so that you can see what the filepath looks like..file path is retreived from the db so it changes with each iteration through the loop.

Thanks,
Dalia
Here is my code:
Private Sub Form_Load()
    DE2.RetrieveLettersofRec 2009
    
    DE2.rsRetrieveLettersofRec.MoveFirst
    If Not DE2.rsRetrieveLettersofRec.EOF Then
    
        Do While Not DE2.rsRetrieveLettersofRec.EOF
               'This retrieves pdf filepath and pdffile name
               Open_Rec_Letter DE2.rsRetrieveLettersofRec("filepath")
        DE2.rsRetrieveLettersofRec.MoveNext
        Loop
    End If
End Sub
----------------------------------------------------------------------------------------------
   Private Sub Open_Rec_Letter(filepath As String)
 
        Dim ieBrowser As New InternetExplorer
        Dim URL As String
        Dim Flags As Long
        Dim TargetFrame As String
        Dim PostData() As Byte
        Dim Headers As String
 
        URL = filepath ' A URL that will accept a POST
        Flags = 0
        TargetFrame = ""
        PostData = "AAMC_ID=" & frmMainMenu.lblAAMC_IDData.Caption & "&DOB=" & "&App_Year=" & mdlMain.intYear
        
        'VB creates a Unicode string by default; Convert it back to Single byte character set.
        PostData = StrConv(PostData, vbFromUnicode)
    
        Headers = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    
        ieBrowser.Navigate URL, Flags, TargetFrame, PostData, Headers
        ieBrowser.Visible = True
 
        ieBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, "", ""
        ieBrowser.Quit
        Set ieBrowser = Nothing
     
    End Sub

Open in new window

12746255-2009-1061-21-APR-08.pdf
0
dolly2477
Asked:
dolly2477
1 Solution
 
dolly2477Author Commented:
Ha..I found the solution to my above posted problem : ) So do I get points for answering my own question?  See code below!

 
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
      
 
Private Sub Form_Load()
    DE2.RetrieveLettersofRec 2009
    
    DE2.rsRetrieveLettersofRec.MoveFirst
    If Not DE2.rsRetrieveLettersofRec.EOF Then
    
        Do While Not DE2.rsRetrieveLettersofRec.EOF
        
            PrintPDFs DE2.rsRetrieveLettersofRec("filepath")
              
        DE2.rsRetrieveLettersofRec.MoveNext
        Loop
    End If
    
End Sub
 
   Private Sub Open_Rec_Letter(filepath As String)
 
        Dim ieBrowser As New InternetExplorer
        Dim URL As String
        Dim Flags As Long
        Dim TargetFrame As String
        Dim PostData() As Byte
        Dim Headers As String
        
 
        URL = filepath ' A URL that will accept a POST
      
        
        Flags = 0
        TargetFrame = ""
        
        PostData = "AAMC_ID=" & frmMainMenu.lblAAMC_IDData.Caption & "&DOB=" & "&App_Year=" & mdlMain.intYear
        
        'VB creates a Unicode string by default; Convert it back to Single byte character set.
        PostData = StrConv(PostData, vbFromUnicode)
    
        Headers = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    
        ieBrowser.Navigate URL, Flags, TargetFrame, PostData, Headers
        ieBrowser.Visible = True
    
     
    End Sub
 
Private Sub PrintPDFs(PDFArray As Variant)
'' Accepts one dimensional array PrintPDFs containing paths to .PDF files to be printed,
'' then silently prints them using DDE. Acrobat Reader does not support OLE, and silent
'' printing through the pdf.oxc has some issues in v5.1 and higher
''
'' pdf.ocx is an unsupported, non-developement tool that is subject to change in functionality.
'' Under Acrobat 5.1 and higher, a warning dialog is displayed each time printAllFit() is called.
'' If "Do not ask me again" is selected, printing from script will *fail* unless the user opens
'' acrobat reader, goes to tools>options and "Resets all warnings".
'' "Do not ask me again" is stored in:
''   HKCU\Software\Adobe\Acrobat Reader\5.0\AVAlert\cCheckbox\cEWH\iWarnScriptPrintAll
''   HKCU\Software\Adobe\Acrobat Reader\6.0\AVAlert\cCheckbox\cEWH\iWarnScriptPrintAll
''
'' This sub requires:
'' - PDFArray starts at row 0, not row 1
'' - TextBox txtAcrobatDDE
'' - declaration of API function FindExecutable
''
'' ** WILL NOT WORK FROM AN ACTIVEX DLL **
''
 
'On Error GoTo ErrHandler
  
  Dim Error282Count As Integer  '' Count of "Can't open DDE channel" errors
  Dim AcroDDEFailed As Boolean  '' Set to true if a DDE connection cannot be established
  Dim sPDFPath As String        '' Path to a PDF file
  Dim sCmd As String            '' DDE command
  Dim lStatus As Long           '' response from ShellExecute command
  Dim n As Integer              '' for iterating
  Const Max282Errors = 6        '' Number of times we will ignore "Can't open DDE channel" errors
                                '' before accepting the fact that Acrobat is not started. We need
                                '' to test more than once, because it might just be busy loading
  Dim sAcroPath As String       '' Path to acrobat, determined by FindExecutable
  Dim bCloseAcrobat As Boolean  '' If we open acrobat, we will close it when we are done
  
  '' If acrobat is already running (and hidden), shelling it will cause it to be shown.
  '' We do not want that. So try a DDE connect, which will fail if acrobat is not running
  '' I have looked at other API means of testing this, but it may be running as a process (no window)
  '' and there does not seem to be many graceful ways of testing for this.
  Error282Count = Max282Errors      '' we only need to try once to see if it is already running.
  AcroDDEFailed = False             '' ErrHandler will set to true if Acro is not running
  txtAcrobatDDE.LinkMode = 0        '' Close any current DDE Link
  txtAcrobatDDE.LinkTopic = "acroview|control"    '' Acrobat's DDE Application|Topic
  txtAcrobatDDE.LinkMode = 2        '' Try to establish 'Manual' DDE Link. This will fail
                                    '' if Acrobat is not ready (or in this case, not running)
  
  If AcroDDEFailed = True Then
    '' We could not set our linkmode, so Acro is not running. Find it and launch it
    sPDFPath = PDFArray(0)  '' grab the first pdf path. We assume this file exists
    
    '' Use the FindExecutable API function to grab the path to our PDF handler.
    '' This should be Acrobat Reader or Acrobat, but it might be something else.
    '' When we try to DDE link to it, non-acrobat will error out. This is ok.
    sAcroPath = String(128, 32)
    lStatus = FindExecutable(sPDFPath, vbNullString, sAcroPath)
    If lStatus <= 32 Then
      MsgBox "Acrobat could not be found on this computer. Printing cancelled", vbCritical, "Problem"
      Exit Sub
    End If
    
    '' Launch the PDF handler
    lStatus = Shell(sAcroPath, vbHide)
    If (lStatus >= 0) And (lStatus <= 32) Then
      MsgBox "An error occured launching Acrobat. Printing cancelled", vbCritical, "Problem"
      Exit Sub
    End If
    bCloseAcrobat = True  '' We will try to close Acrobat when we are done
  End If
  
  PauseFor 2  '' Lets take a break here to let Acrobat finish loading
  
  Error282Count = 0       '' This time, we will allow all acceptable tries, as
  AcroDDEFailed = False   '' Acrobat is running, but may be busy loading its modules
  txtAcrobatDDE.LinkMode = 0
  txtAcrobatDDE.LinkTopic = "acroview|control"
  txtAcrobatDDE.LinkTimeout = 2500 ' 3 minute timeout delay. Should be moer than enough
  txtAcrobatDDE.LinkMode = 2
  
  If AcroDDEFailed = True Then
    MsgBox "An error occured connecting to Acrobat. Printing cancelled", vbCritical, "Problem"
    Exit Sub
  End If
  
  '' Send the PDF's to the printer. In my testing, this was very immediate
 ' For n = 0 To UBound(PDFArray)
    '' We need to put the long filenames in quotes. Again, we assume these file exist
    sPDFPath = PDFArray
    sCmd = "[FilePrintSilent(" & Chr(34) & sPDFPath & Chr(34) & ")]"
    txtAcrobatDDE.LinkExecute sCmd
  'Next
 
  If bCloseAcrobat = True Then
    '' [AppExit()] causes memory errors with v6.0 and 6.1, so avoid closing these versions
    If InStr(sAcroPath, "6.0") = 0 Then
      sCmd = "[AppExit()]"
      txtAcrobatDDE.LinkExecute sCmd
    End If
  End If
  
  '' Close the DDE Connection
  txtAcrobatDDE.LinkMode = 0
 
Exit Sub
 
ErrHandler:
  If Err.Number = 282 Then '' Can't open DDE channel
    '' This error may happen because Acro is not fully loaded.
    '' Give it Max282Errors attempts before returning AcroDDEFailed = True
    Error282Count = Error282Count + 1
    If Error282Count <= Max282Errors Then
      PauseFor 3
      Resume
    Else
      AcroDDEFailed = True
      Resume Next
    End If
  End If
  
  MsgBox "Error in PrintPDFs sub of " & Me.Name & " form. Error# " & Err.Number & " " & Err.Description & "."
End Sub
 
Private Sub PauseFor(iSeconds As Integer)
'' Pauses for iSecond seconds
  Dim sngTimer As Single
  
  sngTimer = Timer
  While Timer - sngTimer < iSeconds
    DoEvents
  Wend
 
End Sub

Open in new window

0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

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