NOTE: I have not fully tested this (e.g. don't know what might happen if a user happens to have Adobe open to create pdfs when they run any of this).
To print all pdf's in a particular folder, put this into an event of your choice (such as a button click event):
THIS PART AT THE TOP OF THE MODULE WHERE THE CLICK EVENT IS, UNDER OPTION COMPARE DATABASE and OPTION EXPLICIT:
Code:
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
Then as part of the click event, put this between the sub and end sub statements
Code:
Sub PrintAllFolderPDFs()
Dim n As Long
Dim pdfFile As String, strPath As String
On Error GoTo errHandler
strPath = getPath
pdfFile = Dir(strPath & "*.pdf") 'getPath appends the required ending backslash
Do While pdfFile <> ""
n = ShellExecute(hWndAccessApp, "print", _
strPath & pdfFile, vbNullString, vbNullString, 0&)
pdfFile = Dir
Loop
exitHere:
'***
'to close the pdf application, create the modules as instructed in the rest of the forum post
' and run fEnumWindows when your pdf application is open, to get the name of your pdf application.
'Then enter the name between the quotes in the next line.
'fCloseApp "put name of pdf application here in quotes"
'***
errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
End Sub
This should work, but will likely leave the pdf application window open unless you enable the part between the ***. It would be simple enough to just have the user close it manually, or you can add the following (but I would get the first part working before trying to augment it).
Create a new standard module called mdlGetAppClassName and paste this in (again, after your Option lines as mentioned above). When your pdf reader application is open, run it to get the name of your pdf reader application (which will print out in the Access vb editor Immediate window):
Code:
'************** 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 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 ***************
IF you are going to implement the code in your button click event in order to close the pdf application, Create another standard module called mdlCloseApp as per the previous instructions and paste this into it:
Code:
'************** 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 ***************
Good luck, and take note of the part of my signature block that warns you to test code in copies of your db objects whenever there is risk.