Option Compare Database
Option Explicit
 
'---------------------------------------------------------------------------------------
' This code was originally written by Alex Dybenko
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application, provided the copyright notice is left unchanged.
 
' Copyright 1998-2008 Alex Dybenko. All Rights Reserved.
' http://AccessBlog.net
' http://www.PointLtd.com
'---------------------------------------------------------------------------------------
Private Declare Function FindExecutable Lib "shell32.dll" _
    Alias "FindExecutableA" (ByVal lpFile As StringByVal lpDirectory As String, _
    ByVal lpResult As StringAs Long

Public Function PrintPDF(FileName As VariantAs Boolean
 
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 strCmd As String            '' DDE command
    Dim lStatus As Long           '' response from ShellExecute command
    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
    Static strAcroPath 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
 
    Dim lngChanel As Long
    lngChanel = DDEInitiate("acroview", "control")
 
    If AcroDDEFailed = True Then
 
        '' 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.
        If Len(strAcroPath) = 0 Then
            strAcroPath = String(128, 32)
            lStatus = FindExecutable(FileName, vbNullString, strAcroPath)
            If lStatus <= 32 Then
                MsgBox "Acrobat could not be found on this computer. Printing cancelled", vbCritical, "Problem"
                Exit Function
            End If
        End If
        '' Launch the PDF handler
        lStatus = Shell(strAcroPath, vbHide)
        If (lStatus >= 0) And (lStatus <= 32) Then
            MsgBox "An error occured launching Acrobat. Printing cancelled", vbCritical, "Problem"
            Exit Function
        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
 
    lngChanel = DDEInitiate("acroview", "control")
    If AcroDDEFailed = True Then
        MsgBox "An error occured connecting to Acrobat. Printing cancelled", vbCritical, "Problem"
        Exit Function
    End If
    strCmd = "[FilePrintSilent(" & Chr(34) & FileName & Chr(34) & ")]"
    DDEExecute lngChanel, strCmd
 
    PrintPDF = True
    If bCloseAcrobat = True Then
        If InStr(strAcroPath, "6.0") = 0 Then
            strCmd = "[AppExit()]"
            DDEExecute lngChanel, strCmd
        End If
    End If
 
    DDETerminateAll
Exit Function
 
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 PrintPDF sub Error# " & Err.Number & " " & Err.Description & "."
End Function

Private Sub PauseFor(iSeconds As Integer'' Pauses for iSecond seconds
    Dim sngTimer As Single
 
    sngTimer = Timer
    While Timer - sngTimer < iSeconds
      DoEvents
    Wend
End Sub