How to loop through all pdfs in a folder and copy them to Excel 2016

[Pikopako]

Hi,

Am an struggling with the following problem. I need to copy pdf sales invoices to Excel 2016, into 1 Sheet, one under the other i.e. all in 1 column. As the amount of documents is big doing it manually is totally counterproductive. I tried to find a suitable piece of VBA Code to do this but only managed to open 1 File and copy it to Excel. the Code below:

Sub Start_Adobe()

Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe

AdobeApp = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
AdobeFile = "C:\Users\prmk3\Documents\01 PM\01 DE\04 RTR\TUGU_5043121_1.pdf"

StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)

Application.OnTime Now + TimeValue("00:00:01"), "FirstStep"

End Sub

Private Sub FirstStep()

SendKeys ("^a")
SendKeys ("^c")

Application.OnTime Now + TimeValue("00:00:01"), "SecondStep"

End Sub

Private Sub SecondStep()

AppActivate "TEST GS 20171108v1556.xlsm - Excel"

Sheets("GS").Activate
Range("A2").Activate
SendKeys ("^v")

End Sub

Now I need to make the code Loop through the files but this is something which is beyond my VBA abilities. I would also like the whole Code to be in 1 Procedure so without the Private Subs. Please HELP as otherwise I'll have to become the worlds fastest Ctrl C + Ctrl V typer...

 

[tlowry]

Is this what you want?

Sub doAllPDFs()
    Const sPath = "C:\Temp\" '< change this >
    Dim AdobeFile
    Select Case Dir(sPath, vbDirectory)
        Case ""
            Debug.Print sPath & " is not available."
        Case Else
            AdobeFile = Dir(sPath & "*.pdf", vbNormal)
            Do While AdobeFile <> ""
                Debug.Print AdobeFile
               
               '==========================
               '< Your code goes here >
               '==========================
               
                AdobeFile = Dir()
            Loop
    End Select
End Sub

 

[Pikopako]

Hi tlowry,

First of all thanks that You took up my problem.

Well, I have pasted my code into yours (although I dont know if correctly). Unfortunately it doesn't work. Adobe gives the message that it was unable to open the file because it cannot. While in Page Break I see that the AdobeFile Variable is set correctly as the first pdf file in the folder. After that everything goes to hell and the loop goes crazy. As a result I need to close Adobe per Process Manager as it stops responding and throws the same Error Window all the time. The Code is still missing the proper copy paste code as I want it to paste the text from the pdf in column A of Workbook.Sheets("GS"). I will deal with that when the loop going through the pdfs is working. Rght now it can overwrite one file with the contents of the next file (paste set always to cell A2). Please find my current code below:

Sub doAllPDFs()
Const sPath = "C:\Temp"
Dim AdobeFile
Dim StartAdobe
Select Case Dir(sPath, vbDirectory)
Case ""
Debug.Print sPath & " is not available."
Case Else
AdobeFile = Dir(sPath & "*.pdf", vbNormal)
Do While AdobeFile <> ""
Debug.Print AdobeFile

AdobeApp = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"

StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)

'Application.OnTime Now + TimeValue("00:00:01"), "FirstStep"

SendKeys ("^a")
SendKeys ("^c")

'Application.OnTime Now + TimeValue("00:00:01"), "SecondStep"


AppActivate "MAKRO - TEST GS 20171114v0600.xlsm - Excel"

Sheets("GS").Activate
Range("A2").Activate
SendKeys ("^v")

AdobeFile = Dir()
Loop
End Select
End Sub

Can You check what is wrong?

 

[Pikopako]

Helloooo

Can anybody help? I will post the code one more time. This time properly:

Sub doAllPDFs()
    Const sPath = "C:\Temp"
    Dim AdobeFile
    Dim StartAdobe
    Select Case Dir(sPath, vbDirectory)
        Case ""
            Debug.Print sPath & " is not available."
        Case Else
            AdobeFile = Dir(sPath & "*.pdf", vbNormal)
            Do While AdobeFile <> ""
                Debug.Print AdobeFile
               
                AdobeApp = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
                 
                StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
                 
                'Application.OnTime Now + TimeValue("00:00:01"), "FirstStep"
                 
                SendKeys ("^a")
                SendKeys ("^c")
                 
                'Application.OnTime Now + TimeValue("00:00:01"), "SecondStep"
 
 
                AppActivate "MAKRO - TEST GS 20171114v0600.xlsm - Excel"
                 
                Sheets("GS").Activate
                Range("A2").Activate
                SendKeys ("^v")
               
                AdobeFile = Dir()
            Loop
    End Select
End Sub