PDF to Excel data copy

vinny2984

Board Regular
Joined
Sep 22, 2008
Messages
202
Does anyone if its possible to write code that will select all in a pdf and copy paste to excel?
I've used the following code to get the PDF file open, which works fine, but thats where it stops for me. If its possible I'd like to be able to continue the code to select all in the PDF doc and paste into excel.
Any ideas?
Thanks

Code:
Shell "C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe C:\users\richard\desktop\RDS\Richard Pay form.pdf"
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Hey Vinny, try tinkering with SENDKEYS (sending keys: ctrl+a to select all, ctrl+c to copy and ctrl+v to paste). Below is a simple example. I also used Application.OnTime to allow time for the application to open and time for copying (you can change the timing to suit your needs - it set for 5 second delay on opening and 10 second delay on copying). As a side note, it has always been my experience that copying from PDF files into Excel makes a yucky mess as it always loses its pretty PDF formatting:


Code:
Sub StartAdobe()
 
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
 
AdobeApp = "C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe"
AdobeFile = "C:\users\richard\desktop\RDS\Richard Pay form.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
 
Upvote 0
crimson, many thanks for that, it works great.
The final touch will be to close the PDF file and program, whcih i've failed to do, if you know how to do that too, that would be excellent.
thanks
 
Upvote 0
AppActivate "Microsoft Excel"

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

End Sub

Hey this code is really cool.......

Well if I had to paste this on to a Word document would it be possible?

I tried replacing the above code with

AppActivate "Microsoft Word"


SendKeys ("^v")

It didnt work though;)....:LOL:
 
Upvote 0
Hi Vinny, you can add another SENDKEYS function (see below revised SecondStep procedure - the item in bold face red is what I added.). By the way, when I was doing all this the only App I had open was Excel. So having other apps open will running the macro could cause unexpected results (e.g. if Adobe was already open). I was hoping you would use this as a general guide to provide you with some direction...any further enhancements are up to you.

Rich (BB code):
Private Sub SecondStep()
 
SendKeys ("%fx")
 
AppActivate "Microsoft Excel"
 
Range("A1").Activate
 
SendKeys ("^v")

End Sub


crimson, many thanks for that, it works great.
The final touch will be to close the PDF file and program, whcih i've failed to do, if you know how to do that too, that would be excellent.
thanks
 
Upvote 0
Crimson, many thanks it works perfectly. Your right, if the pdf is already open it crashes, so i'll play with that to see if i can check if its open before it attempts to open.
Below is the code i used, which is exacly what you sent. There's been no need to change it.
brilliant, thanks

Code:
Sub StartAdobe()
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
 
AdobeApp = "C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe"
AdobeFile = "C:\users\richard\desktop\RDS\Richard Pay form.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
 
Upvote 0
I'm trying to use this to cycle through some files in a directory and copy and paste the contents into new sheets in my workbook...it looks like it fails out at the call to FirstStep...

Any ideas?

Code:
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
Dim strPath As String
Dim strFile As String
Sub LoopThruDirectory()
    

    strPath = "C:\_ImportTest\"
    strFile = Dir(strPath)

    Do While strFile <> “”
        Sheets.Add After:=Sheets(Sheets.Count)
        StartAdobeApp
        strFile = Dir    ' Get next entry.
    Loop
    
End Sub
Sub StartAdobeApp()

AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe"
AdobeFile = strPath & strFile
  
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"
Call SecondStep
End Sub
 
Private Sub SecondStep()
SendKeys ("%fx")
AppActivate "Microsoft Excel"
ThisWorkbook.Activate
Range("A1").Activate
SendKeys ("^v")
End Sub
 
Upvote 0
Crimson, i ran the below, but i got an error "There was an error opening this document. This file cannot be found". I have closed everything apart from excel

There needs to be flexibility in choosing file via a dialgoue box.


Hey Vinny, try tinkering with SENDKEYS (sending keys: ctrl+a to select all, ctrl+c to copy and ctrl+v to paste). Below is a simple example. I also used Application.OnTime to allow time for the application to open and time for copying (you can change the timing to suit your needs - it set for 5 second delay on opening and 10 second delay on copying). As a side note, it has always been my experience that copying from PDF files into Excel makes a yucky mess as it always loses its pretty PDF formatting:


Code:
Sub StartAdobe()
 
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
 
AdobeApp = "C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe"
AdobeFile = "C:\users\richard\desktop\RDS\Richard Pay form.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
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,044
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top