Results 1 to 10 of 10
  1. #1
    Khatuaaccess is offline Novice
    Windows 7 32bit Access 2016
    Join Date
    Jul 2016
    Posts
    13

    Need access vba to Print all pdf from a fix folder


    hi,

    is it possible to print all pdf files from a particular folder using access 2016 vba.

    can you please help me with the code.


    Regards
    Prasanta

  2. #2
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    7,069
    Do you want to be able to navigate to and pick a folder only and print all the pdf's inside, or do you want to be able to multi-select them?
    Or do you know the path and it will not change each time?
    Or do you intend to store the path in a table as one of possibly many db parameters you might have, and getting it from there?

    If you are converting reports to pdf's then printing them, a printed report is virtually the same as a report converted to pdf AFAIK. The only reason I could think of to convert would be to send pdf copies to anyone who does not have Access, but then you wouldn't be the one printing them.
    - "doesn't work" doesn't help. Implement changes in copies of your database.
    "Everyone has a photographic memory; some just don't have film." Steven Wright

  3. #3
    Khatuaaccess is offline Novice
    Windows 7 32bit Access 2016
    Join Date
    Jul 2016
    Posts
    13
    yes i have a folder with a some pdf files already stored.
    i want to print all those pdf and close the pdf window

  4. #4
    ranman256's Avatar
    ranman256 is online now VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    8,201
    ''usage on button click:
    PrintAllFilesInDir "C:\Users\folder\Documents"

    Code:
       'THIS MUST BE DECLARED AT TOP OF MODULE:
    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
    
    Public Sub PrintAllFilesInDir(ByVal pvDir)
    Dim vFil As String, vTargT
    Dim i As Integer
    Dim fso
    Dim oFolder, oFile
    Dim vOutFile
    
    On Error GoTo errImp
    If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(pvDir)
    
    For Each oFile In oFolder.Files
        vFil = pvDir & oFile.Name
        If InStr(vFil, ".pdf") > 0 Then      'ONLY DO PDF FILES
               'Print vFil
               Call ShellExecute(0, "print", vFil, "", "", 1)
        End If
    Next
    
    Set fso = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
    MsgBox "Done"
    Exit Sub
    
    errImp:
    MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
    Exit Sub
    Resume

  5. #5
    Khatuaaccess is offline Novice
    Windows 7 32bit Access 2016
    Join Date
    Jul 2016
    Posts
    13
    hi,

    thanks,

    Please advise where can i set the directory for pdfs location(pvDir)

  6. #6
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    7,069
    I seem to have a different interpretation of what you need - code to get the folder path first, then something to print out the pdf files. I would break this out into two separate procedures, the first being a function that will return the folder path chosen to any other procedure you may want to use it for in the future. The second would, in your case, be for printing the pdf's in that folder. I'll post the first for now so you can try it. The other will have to come later when I have time (should be today) if the first fulfills your need. I believe this requires a reference to the Office Library.

    Code:
    Function getPath()
    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
    Dim fltr, sql As String
    
    On Error GoTo errHandler
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd
        .ButtonName = "Choose Folder"
        .Title = "Choose PDF Folder"
        .Filters.Clear
        If .Show = -1 Then
            vrtSelectedItem = .SelectedItems.Item(1) & "\" 'multi-select not allowed, so we can specify the item by index
            'The user pressed Cancel.
            Else
            Exit Function
        End If
    End With
    
    getPath = vrtSelectedItem
    msgbox getPath 'comment out this line later.
    
    exitHere:
    Set fd = Nothing
    Exit Function
    
    errHandler:
        MsgBox Err.Number & ": " & Err.Description
        Resume exitHere
    End If
    
    End Function
    Last edited by Micron; 08-01-2016 at 11:16 AM. Reason: fixed code
    - "doesn't work" doesn't help. Implement changes in copies of your database.
    "Everyone has a photographic memory; some just don't have film." Steven Wright

  7. #7
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    7,069
    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.
    - "doesn't work" doesn't help. Implement changes in copies of your database.
    "Everyone has a photographic memory; some just don't have film." Steven Wright

  8. #8
    Khatuaaccess is offline Novice
    Windows 7 32bit Access 2016
    Join Date
    Jul 2016
    Posts
    13
    Hi,

    Many thanks, the 1st code fulfilled my requirement.

    thanks

  9. #9
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    7,069
    just curious as to which post number you're referring to?

  10. #10
    Khatuaaccess is offline Novice
    Windows 7 32bit Access 2016
    Join Date
    Jul 2016
    Posts
    13
    Function getPath()
    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
    Dim fltr, sql As String

    On Error GoTo errHandler
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    With fd
    .ButtonName = "Choose Folder"
    .Title = "Choose PDF Folder"
    .Filters.Clear
    If .Show = -1 Then
    vrtSelectedItem = .SelectedItems.Item(1) & "" 'multi-select not allowed, so we can specify the item by index
    'The user pressed Cancel.
    Else
    Exit Function
    End If
    End With

    getPath = vrtSelectedItem
    msgbox getPath 'comment out this line later.

    exitHere:
    Set fd = Nothing
    Exit Function

    errHandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume exitHere
    End If

    End Function

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 3
    Last Post: 06-24-2016, 06:51 AM
  2. Replies: 10
    Last Post: 09-09-2015, 03:25 AM
  3. Replies: 1
    Last Post: 05-15-2015, 10:58 AM
  4. Replies: 4
    Last Post: 06-27-2013, 12:29 PM
  5. open folder/Make new folder(example)-VBA Code
    By Madmax in forum Code Repository
    Replies: 3
    Last Post: 03-13-2012, 09:17 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums - Senior Forums