Print a PDF File (1 Viewer)

Module: dTestPrint
Option Compare Database
Option Explicit

'OpenPrintFile()
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

Public Function PrintFile(sFile As String)
On Error GoTo Err_PrintFile

    PrintFile = ShellExecute(Application.hWndAccessApp, "Print", sFile, "", "", 0) '0 = SW_HIDE, 1 = SW_NORMAL, 2 = SW_SHOWMINIMIZED, 3 = SW_MAXIMIZE, 4 = SW_SHOWNOACTIVATE, 6 = SW_MINIMIZE, 7 = SW_SHOWMINNOACTIVE, 9 = SW_RESTORE
  
Exit_PrintFile:
    Exit Function

Err_PrintFile:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "PrintFile()"
    Resume Exit_PrintFile
  
End Function

Public Sub PrintTheFile()
 
    Call PrintFile("C:\Testing\Sample.pdf")
    Call fCloseApp("AcrobatSDIWindow") 'Adobe Acrobat Professional
    MsgBox "Printed file and closed Adobe."
 
End Sub

Module: dFindClassNameOfRunningApp
Option Compare Database
Option Explicit

'[URL="http://www.mvps.org/access/api/api0013.htm"]http://www.mvps.org/access/api/api0013.htm[/URL]
'************** Code Start ***************
' This code was originally written by Dev Ashish.
' 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.
'
' Code Courtesy of
' Dev Ashish
'
'(Q)    How do I find out the Class Name of a running application?
'(A)    Paste the following code in a new module and then run the function fEnumWindows from the Debug window. The function will print out the Class Name and Caption of all running applications that are currently visible.
'
Private Declare Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal hWnd As Long, _
                ByVal lpClassName As String, _
                ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal hWnd As Long, _
                ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal hWnd As Long, ByVal _
                nIndex As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal hWnd As Long, ByVal _
                lpString As String, ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255

Function fEnumWindows()
Dim lngx As Long, lngLen As Long
Dim lngStyle As Long, strCaption As String
    
    lngx = apiGetDesktopWindow()
    'Return the first child to Desktop
    lngx = apiGetWindow(lngx, mcGWCHILD)
    
    Do While Not lngx = 0
        strCaption = fGetCaption(lngx)
        If Len(strCaption) > 0 Then
            lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
            'enum visible windows only
            If lngStyle And mcWSVISIBLE Then
                Debug.Print "Class = " & fGetClassName(lngx),
                Debug.Print "Caption = " & fGetCaption(lngx)
            End If
        End If
        lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
    Loop
End Function
Private Function fGetClassName(hWnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer
   
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetClassName(hWnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetClassName = Left$(strBuffer, intCount)
    End If
End Function

Private Function fGetCaption(hWnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer

    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetWindowText(hWnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetCaption = Left$(strBuffer, intCount)
    End If
End Function
'************** Code End ***************

Module: dCloseAnotherApplication
Option Compare Database
Option Explicit

'[URL="http://www.mvps.org/access/api/api0025.htm"]http://www.mvps.org/access/api/api0025.htm[/URL]
'************** Code Start ***************
' This code was originally written by Dev Ashish.
' 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.
'
' Code Courtesy of
' Dev Ashish
'
Private Const WM_CLOSE = &H10
Private Const INFINITE = &HFFFFFFFF

Private Declare Function apiPostMessage _
    Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

Private Declare Function apiFindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) _
    As Long
    
Private Declare Function apiWaitForSingleObject _
    Lib "kernel32" Alias "WaitForSingleObject" _
    (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) _
    As Long
    
Private Declare Function apiIsWindow _
    Lib "user32" Alias "IsWindow" _
    (ByVal hWnd As Long) _
    As Long
        
Private Declare Function apiGetWindowThreadProcessId _
    Lib "user32" Alias "GetWindowThreadProcessId" _
    (ByVal hWnd As Long, _
    lpdwProcessID As Long) _
    As Long
        
Function fCloseApp(lpClassName As String) As Boolean
'Usage Examples:
'   To close Calculator:
'       ?fCloseApp("SciCalc")
'
Dim lngRet As Long, hWnd As Long, pID As Long

    hWnd = apiFindWindow(lpClassName, vbNullString)
    If (hWnd) Then
        lngRet = apiPostMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
        Call apiGetWindowThreadProcessId(hWnd, pID)
        Call apiWaitForSingleObject(pID, INFINITE)
        fCloseApp = Not (apiIsWindow(hWnd) = 0)
    End If
End Function
'************* Code End ***************