Loop Through directory files

[MHamid]

Hello,

I have the below excel code that will open Adobe Reader. Then it will open a PDF file, copy data in 1st page and paste it into an excel document.

Somehow I need to figure out the below:

1. Loop through all PDF files in the directory
2. Open one file at a time, copy the data in the 1st page, close adobe and do it again for the next PDF file it finds

As it is now it will only do one file specified in the current code and will copy the data in column A.
I would like to update the code to loop through all the files within the directory and copy each file into it's own column. For instance, the first PDF file will be copied to column A, the 2nd PDF File will be copied to column B the 3rd file will be copied to column C, and so forth within the same sheet.

Sub StartAdobe()
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
 
AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader 2015\Reader\AcroRd32.exe"
'AdobeFile = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\A16806 - US Funds Transfer Systems Process Audit Report FINAL.pdf"
 
StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
 
Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"
End Sub
Private Sub FirstStep()
SendKeys ("^a")
SendKeys ("^c")
 
Application.OnTime Now + TimeValue("00:00:10"), "SecondStep"
 
End Sub
 
Private Sub SecondStep()
SendKeys ("%fx")
AppActivate "Microsoft Excel"
ThisWorkbook.Activate
Sheets(1).Activate
Range("A1").Activate
SendKeys ("^v")
End Sub

Any ides?

Thank you

 

[fallore]

You mentioned the "below excel code" but it doesn't appear as if you've attached it, may want to correct

 

[PatOBrien198]

maybe something like:

Sub LoopThruFiles()
Dim fName As String
Dim folderName As String
Dim AdobeFile

folderName = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\"
fName = Dir(folderName & "*.pdf")
Do While fName <> ""
    AdobeFile = folderName & fName
    StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
     
    Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"
    fName = Dir
Loop
End Sub

you may need to deal with closing the adobe file

 

[MHamid]

PatOBrien, I tried your code and it opened all the files in the folder. However, it's not doing the second part that I need, which is copy each file into 1 column. For instance, File 1 is copied to column A, File 2 is coped to column B, File 3 is copied to column C, and so forth for how many files there are.

 

[PatOBrien198]

Global FileCount As Integer

Sub LoopThruFiles()
Dim fName As String
Dim folderName As String
Dim AdobeFile
FileCount = 0
folderName = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\"
fName = Dir(folderName & "*.pdf")
Do While fName <> ""
    AdobeFile = folderName & fName
    StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
     
    Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"
    fName = Dir
    FileCount = FileCount + 1
Loop
End Sub

Private Sub FirstStep()
   SendKeys ("^a")
   SendKeys ("^c")
 
   Application.OnTime Now + TimeValue("00:00:10"), "SecondStep"
 
End Sub



Private Sub SecondStep()
   SendKeys ("%fx")
   AppActivate "Microsoft Excel"
   ThisWorkbook.Activate
   Sheets(1).Activate
   Range("A1").Offset(0, FileCount).Activate  ' this is where the column offset is made 
   SendKeys ("^v")
End Sub

 

[MHamid]

It's still just copying one file only. It's not copying all of the files.

This is what it looks like it's doing. It is opening all of the files first and then it copies the data from the last file opened.
Is there a way to re-code this to open a file, copy data, and paste it one at a time?

Global FileCount As Integer
 
Sub StartAdobe()
Dim AdobeApp As String
Dim AdobeFile As String
Dim strPath As String
Dim strFile As String
Dim StartAdobe
 
FileCount = 0
strPath = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\"
strFile = Dir(strPath & "*.pdf")
 
Do While strFile <> ""
    AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader 2015\Reader\AcroRd32.exe"
    AdobeFile = strPath & strFile
    'AdobeFile = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\A16806 - US Funds Transfer Systems Process Audit Report FINAL.pdf"
 
    StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
    Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"
    strFile = Dir
    FileCount = FileCount + 1
Loop
End Sub
Private Sub FirstStep()
SendKeys ("^a")
SendKeys ("^c")
 
Application.OnTime Now + TimeValue("00:00:10"), "SecondStep"
 
End Sub
 
Private Sub SecondStep()
'SendKeys ("%fx")
AppActivate "Microsoft Excel"
ThisWorkbook.Activate
Sheets(1).Activate
'Range("A1").Activate
Range("A1").Offset(0, FileCount).Activate
SendKeys ("^v")
 
End Sub

 

[PatOBrien198]

Instead of using "Application.OnTime" to start up a new subroutine in 5 or 10 seconds, try this - merely pausing the code execution for a couple of seconds.

Sub StartAdobe()
Dim AdobeApp As String
Dim AdobeFile As String
Dim strPath As String
Dim strFile As String
Dim StartAdobe
Dim FileCount As Integer
 
FileCount = 0
strPath = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\"
strFile = Dir(strPath & "*.pdf")
 
Do While strFile <> ""
    AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader 2015\Reader\AcroRd32.exe"
    AdobeFile = strPath & strFile
    'AdobeFile = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\A16806 - US Funds Transfer Systems Process Audit Report FINAL.pdf"
 
    StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
    Call PauseForSeconds(2)
    SendKeys ("^a")
    SendKeys ("^c")
    Call PauseForSeconds(2)
    AppActivate "Microsoft Excel"
    ThisWorkbook.Activate
    Sheets(1).Activate
    Range("A1").Offset(0, FileCount).Activate
    SendKeys ("^v")
    strFile = Dir
    FileCount = FileCount + 1
Loop
End Sub
Sub PauseForSeconds(s As Integer)
    Dim starttime As Long
    starttime = Timer
    Do While Timer < starttime + s
        DoEvents
    Loop
End Sub

 

[MHamid]

The data copied into each column. However, out of 9 pdf files currently in the folder only 5 were copied and 3 of those were duplicated. Plus it only copied a total of 8 instead of 9.
I kept getting a message that the data was not the same size (3 times I got that message).

 

[PatOBrien198]

Let's try clearing the clipboard after the data is pasted.....

after the "SendKeys ("^v")
add the following line of code:

Application.CutCopyMode = False

On what line of code do you get the error message?