Open multiple PDF files from certain path

**amoxia** · 12-12-2013, 07:06 PM

Hi all,

I have found a code that opens up a single pdf document and then from there I can save it as a txt file then open it and copy the text into excel. But I want to do it to multiple pdf files that are in the same folder - this part I'm having a problem with. So once it saves it as a text file open the first one up copy the data in column A, then loop to the next pdf save it as the same text file name that's ok then paste the data in column B.

Any help would be much appreciated.

Code below:

Dim AcroXApp As Object
    Dim AcroXAVDoc As Object
    Dim AcroXPDDoc As Object
     
     
    Set AcroXApp = CreateObject("AcroExch.App")
    AcroXApp.Hide
     
     
    Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
    AcroXAVDoc.Open "C:\PDF test\blah.pdf", "Acrobat"
     
     
    AcroXAVDoc.BringToFront
     
     
    Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
     
     
    Dim jsObj As Object
    Set jsObj = AcroXPDDoc.GetJSObject
     
     
    jsObj.SaveAs "C:\PDF test\test.txt", "com.adobe.acrobat.accesstext"
     
     
    AcroXAVDoc.Close False
    AcroXApp.Hide
    AcroXApp.Exit

Dim Text
    Dim i As Long
Worksheets("sheet2").Activate


    Application.ScreenUpdating = False
     'put your own path below
    Open ActiveWorkbook.Path & "\test.txt" For Input As #1
    i = 1
    Do While Not EOF(1) ' Loop until end of file.
        Input #1, Text
        Range("a" & i) = Text
        i = i + 1
    Loop
    Close #1

**JBeaucaire** · 12-14-2013, 04:50 AM

Untested, something like this to get you closer...

Option Explicit

Sub Test()
Dim Text As String, Rw As Long, Col As Long
Dim AcroXApp As Object, AcroXAVDoc As Object, AcroXPDDoc As Object, jsObj As Object
Dim PDFpath As String, pdfNAME As String, wsDEST As Worksheet

Application.ScreenUpdating = False
Set AcroXApp = CreateObject("AcroExch.App")
AcroXApp.Hide
Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
    
Set wsDEST = Sheets("Sheet2")           'sheet in activeworkbook to copy data into
wsDEST.UsedRange.Clear                  'clear existing data from this worksheet
Col = 1                                 'the first column to copy data into
PDFpath = "C:\PDF test\"                'remember the final \ in this pdf path string
pdfNAME = Dir(PDFpath & "*.pdf")        'get first filename from this path

Do While Len(pdfNAME) > 0               'process one file at a time
    AcroXAVDoc.Open PDFpath & pdfNAME, "Acrobat"        'open first found pdf
    AcroXAVDoc.BringToFront
    Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
    Set jsObj = AcroXPDDoc.GetJSObject
                                                        'save to text file of same name
    jsObj.SaveAs Replace(PDFpath & pdfNAME, ".pdf", ".txt"), "com.adobe.acrobat.accesstext"

    AcroXAVDoc.Close False              'close opened pdf
    AcroXApp.Hide
    AcroXApp.Exit
                                        'read in text file created one line at a time
    Open Replace(PDFpath & pdfNAME, ".pdf", ".txt") For Input As #1
    Rw = 1
    Do While Not EOF(1)                 'Loop until end of file.
        Input #1, Text                  'read a line
        wsDEST.Cells(Rw, Col) = Text    'write a line
        Rw = Rw + 1                     'incremenet to next row
    Loop
    Close #1                            'close opened text file
    Col = Col + 1

    pdfNAME = Dir                       'get next PDF filename from same path
Loop                                    'repeat

Application.ScreenUpdating = True
End Sub

**amoxia** · 12-15-2013, 07:36 PM

Awesome!! That worked.

Thank you so much JBeaucaire!!!

I just left the text file name as the one name though as I didn't want heaps of text files, just wanted them stored into excel.

Thanks again!