How to copy data from pdf to excel using VBA for multiple sheets?

[harikris2013]

Hi,

I have 200 sheets of data in PDF file which needs to copy to 200 sheets in excel workbook

I need to use only acrobat reader 5.

I have below macro which is copying only one and pasting to sheet1

Please modify the below macro

Sub StartAdobe()

Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe

AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe"
AdobeFile = "C:\Users\Dell\Desktop\Dead Men Tell No Tales.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()

AppActivate "Microsoft Excel"

Range("A1").Activate
SendKeys ("^v")


End Sub

 

[harikris2013]

it is not 200 files in desktop i have pdf with 200 pages that needs to be copied to 200 sheets in excel.

Path: C:\Users\Dell\Desktop\pdf to excel\TITLE SPOKE.pdf

I am getting error in line when i debug -
AppActivate "Adobe Reader"

 

[sijpie]

OK, I misunderstood, that was why I questioned that in my first post: I asked if it was one file or many files.

My macro is for many files to many sheets.

For your case I would not know how to go about it, as in Acrobat reader you would have to copy the text off each individual page. I am assuming you can send a next page key, but I would not know how to select the text of only one page at a time.

The alternative would be to copy paste the total document into one sheet in Excel and then split it up into multiple sheets from there using footers or so as the markers of the split.
unfortunately I do not have time this week to look into this.

At which line (when you run my code and debug) do you get the error? which line is highlighted yellow?

 

[harikris2013]

Thanks for ur response I have alternate solution coping whole pdf then splitting to each sheet
I was getting error in line AppActivate "Adobereader"

 

[HankJ]

Hi sijpie
I used this code, with a tweek for location of Reader in 2016 and it worked a treat.
Many thanks for your time
HankJ

 

[Jishnu Surendran]

Are these 200 pages in one pdf, or 200 pdf files? I am assuming the latter although you write that it is only one file.

You need to loop through each of the files in a sub that then calls the startAdobe sub. But somewhere you will also want to close the pdf files.

Let's assume that all the pdf files are in one folder. The following will do the trick. I have used some of your code, but not the paste part, as we can use Excel's paste for that.


Read throuh the code (plus comments) and see what it does and how it differs from yours


Option Explicit

Sub LoopThroughFiles()
****Dim strFile As String, strPath As String
****Dim colFiles As New Collection
****Dim i As Integer
****Dim rLog As Range, rOut As Range
****Dim wsLog As Worksheet, wsOutp As Worksheet
****
****strPath = "C:\TEMP\"
****strFile = Dir(strPath)
****' Make a log sheet
****On Error Resume Next
****Set wsLog = Sheets("PdfProcessLog")
****On Error GoTo 0
****If wsLog Is Nothing Then
********Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1))
********wsLog.Name = "PdfProcessLog"
****End If
****Set rLog = wsLog.Range("A1")
****rLog.CurrentRegion.ClearContents
****rLog.Value = "PDF files copied to sheets"
****
****' load all the files in a Collection
****While strFile <> ""
********If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then
************colFiles.Add strFile
********End If
********strFile = Dir
****Wend
****
****Application.DisplayAlerts = False
****
****'Loop through the pdf's stored in the collection
****For i = 1 To colFiles.Count
********'List filenames in Column A of the log sheet
********rLog.Offset(i, 0).Value = colFiles(i)
********strFile = Left(colFiles(i), Len(colFiles(i)) - 4)
********
********' Delete sheet with filename if exists
********On Error Resume Next
********Set wsOutp = Sheets(strFile)
********On Error GoTo 0
********If Not wsOutp Is Nothing Then
************wsOutp.Delete
********End If
********' (Re)Create the worksheet, give it the file name
********Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog)
********wsOutp.Name = strFile
********
********' Now open the file, and copy contents
********OpenClosePDF colFiles(i), strPath
********CopyStep wsOutp
****Next i
****
****Application.DisplayAlerts = True

End Sub
Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String)

****Dim sAdobeApp As String
****Dim vStartAdobe As Variant
****
****sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe"
****sAdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe"
****vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1)
****Application.Wait (Now + TimeValue("0:00:01"))

End Sub


Private Sub CopyStep(wsOutp As Worksheet)

****' select all & copy
****SendKeys "^a", True
****SendKeys "^c", True
**** Application.Wait (Now + TimeValue("0:00:01"))
** ' Paste into the sheet from cell A1
****wsOutp.Paste Cells(1, 1)
**
****Application.Wait (Now + TimeValue("0:00:01"))
****AppActivate "Adobe Reader"
****' close Reader
****SendKeys "%{F4}", True

End Sub

I am getting "400" error after creating the new worksheet which is to be renamed as the file name. I believe there is a problem in renaming command. Can you help ?

 

[sijpie]

The code uses the file names to name the sheets. I amnot sure what your filenames look like, but perhaps there are characters in there that Excel does not allow, or you have two files with the same name. you can’t use any of the following characters in a name:

1. \
2. /
3. *
4. [
5. ]
6. :
7. ?

Also not

1. 'History'
2. More than 32 characters

 

[dannyok90]

Are these 200 pages in one pdf, or 200 pdf files? I am assuming the latter although you write that it is only one file.

You need to loop through each of the files in a sub that then calls the startAdobe sub. But somewhere you will also want to close the pdf files.

Let's assume that all the pdf files are in one folder. The following will do the trick. I have used some of your code, but not the paste part, as we can use Excel's paste for that.


Read throuh the code (plus comments) and see what it does and how it differs from yours


Option Explicit

Sub LoopThroughFiles()
Dim strFile As String, strPath As String
Dim colFiles As New Collection
Dim i As Integer
Dim rLog As Range, rOut As Range
Dim wsLog As Worksheet, wsOutp As Worksheet

strPath = "C:\TEMP"
strFile = Dir(strPath)
' Make a log sheet
On Error Resume Next
Set wsLog = Sheets("PdfProcessLog")
On Error GoTo 0
If wsLog Is Nothing Then
Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1))
wsLog.Name = "PdfProcessLog"
End If
Set rLog = wsLog.Range("A1")
rLog.CurrentRegion.ClearContents
rLog.Value = "PDF files copied to sheets"

' load all the files in a Collection
While strFile <> ""
If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then
colFiles.Add strFile
End If
strFile = Dir
Wend

Application.DisplayAlerts = False

'Loop through the pdf's stored in the collection
For i = 1 To colFiles.Count
'List filenames in Column A of the log sheet
rLog.Offset(i, 0).Value = colFiles(i)
strFile = Left(colFiles(i), Len(colFiles(i)) - 4)

' Delete sheet with filename if exists
On Error Resume Next
Set wsOutp = Sheets(strFile)
On Error GoTo 0
If Not wsOutp Is Nothing Then
wsOutp.Delete
End If
' (Re)Create the worksheet, give it the file name
Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog)
wsOutp.Name = strFile

' Now open the file, and copy contents
OpenClosePDF colFiles(i), strPath
CopyStep wsOutp
Next i

Application.DisplayAlerts = True

End Sub
Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String)

Dim sAdobeApp As String
Dim vStartAdobe As Variant

sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe"
sAdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe"
vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1)
Application.Wait (Now + TimeValue("0:00:01"))

End Sub


Private Sub CopyStep(wsOutp As Worksheet)

' select all & copy
SendKeys "^a", True
SendKeys "^c", True
Application.Wait (Now + TimeValue("0:00:01"))
' Paste into the sheet from cell A1
wsOutp.Paste Cells(1, 1)

Application.Wait (Now + TimeValue("0:00:01"))
AppActivate "Adobe Reader"
' close Reader
SendKeys "%{F4}", True

End Sub

Hi! Re-opening this, because it sounds like its just what I need

how could I get this code to open an explorer window so I can locate the folder that contains all the PDF's rather than specifying a file path?

Thanks :D

 

[sijpie]

by using <code>Application.FileDialog method.

You can use that to select a directory and then use the selected directory name to go through all the files within that directory.
</code>

links:
https://www.mrexcel.com/forum/excel-questions/294728-browse-folder-vba.html

 

[MHamid]

Hello,

I am currently trying to use this code and the data is being copied into the same sheet over the previously pasted data.
If I am not mistaken, this code is supposed to copy and paste the data into it's own sheet for each pdf file, right?

What am I missing here to get all pdf files to be copied into it's own worksheet?

Option Explicit


Sub LoopThroughFiles()
    Dim strFile As String, strPath As String
    Dim colFiles As New Collection
    Dim i As Integer
    Dim rLog As Range, rOut As Range
    Dim wsLog As Worksheet, wsOutp As Worksheet
    
    strPath = "i:\CAP_Profile\Desktop\Projects\Audit Plan\Reports\"
    strFile = Dir(strPath)
    ' Make a log sheet
    On Error Resume Next
    Set wsLog = Sheets("PdfProcessLog")
    On Error GoTo 0
    If wsLog Is Nothing Then
        Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1))
        wsLog.Name = "PdfProcessLog"
    End If
    Set rLog = wsLog.Range("A1")
    rLog.CurrentRegion.ClearContents
    rLog.Value = "PDF files copied to sheets"
    
    ' load all the files in a Collection
    While strFile <> ""
        If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then
            colFiles.Add strFile
        End If
        strFile = Dir
    Wend
    
    Application.DisplayAlerts = False
    
    'Loop through the pdf's stored in the collection
    For i = 1 To colFiles.Count
        'List filenames in Column A of the log sheet
        rLog.Offset(i, 0).Value = colFiles(i)
        strFile = Left(colFiles(i), Len(colFiles(i)) - 4)
        
        ' Delete sheet with filename if exists
        On Error Resume Next
        Set wsOutp = Sheets(strFile)
        On Error GoTo 0
        If Not wsOutp Is Nothing Then
            wsOutp.Delete
        End If
        ' (Re)Create the worksheet, give it the file name
        Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog)
        wsOutp.Name = Left(strFile, 25)
        
        ' Now open the file, and copy contents
        OpenClosePDF colFiles(i), strPath
        CopyStep wsOutp
    Next i
    
    Application.DisplayAlerts = True
End Sub
Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String)
    Dim sAdobeApp As String
    Dim vStartAdobe As Variant
    
    sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader 2015\Reader\AcroRd32.exe"
    'sAdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe"
    vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1)
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub
Private Sub CopyStep(wsOutp As Worksheet)
    
    ' select all & copy
    SendKeys "^a", True
    SendKeys "^c", True
     Application.Wait (Now + TimeValue("0:00:01"))
   ' Paste into the sheet from cell A1
    wsOutp.Paste Cells(1, 1)
   
    Application.Wait (Now + TimeValue("0:00:01"))
    AppActivate "Adobe Acrobat Reader DC"
    ' close Reader
    SendKeys "%{F4}", True
End Sub

 

[sijpie]

The code should create a new sheet for each file. It first checks ( in the loop) if a sheet with the name of the file exists, and deletes this sheet if so. Then it creates the sheet an copies the off to it.

I suggest you step through the code, by clicking in it somewhere and then using the F8 key to step through. You can then check if the sheet gets created etc.