reuben9000
New Member
- Joined
- Feb 8, 2015
- Messages
- 6
Hi All,
So basically I am trying to create a macro which will open up a specified PDF file and copy the text on each page within a particular area onto Excel. In all honesty, I'm not quite sure why my code isn't working, seems fine to me. Can anyone help me out? I've attached the code below. Nothing seems to be pasting in Excel but the document is opening.
Thanks in advance!
Sub NewTestMacro()
Dim AcrobatApp As Acrobat.AcroApp
Dim AcrobatDocument As Acrobat.AcroAVDoc
Dim pdfDoc As Acrobat.AcroPDDoc
Dim Rect As Acrobat.AcroRect
Dim numPages As Integer
Dim Text As String
On Error Resume Next
Set AcrobatApp = CreateObject("AcroExch.App")
Set AcrobatDocument = CreateObject("AcroExch.AVDoc")
Set pdfDoc = CreateObject("AcroExch.PDDoc")
Set Rect = CreateObject("AcroExch.Rect")
Rect.Top = 725 'Bigger seems to be better
Rect.Left = 50 'Lower seems to be better
Rect.Right = 440 'Bigger seems to be better
Rect.bottom = 50 'Lower seems to be better
If AcrobatDocument.Open("C:\Users\42RDO\Desktop\Page 17 10+.pdf", "") Then
AcrobatApp.Show
numPages = pdfDoc.GetNumPages
For i = 1 To numPages
Text = pdfDoc.CreateTextSelect(i, Rect) 'tried to do it by putting the text in a string and then setting Cell Value to be Text but didn't work
SendKeys ("^c"), True
ActiveCell.Offset(1, 0).Select
SendKeys ("^v"), True
Next i
Else
MsgBox PDFPath & " - File not found"
Exit Sub
End If
AcrobatApp.Exit
Set AcrobatApp = Nothing
Set AcrobatDocument = Nothing
End Sub
So basically I am trying to create a macro which will open up a specified PDF file and copy the text on each page within a particular area onto Excel. In all honesty, I'm not quite sure why my code isn't working, seems fine to me. Can anyone help me out? I've attached the code below. Nothing seems to be pasting in Excel but the document is opening.
Thanks in advance!
Sub NewTestMacro()
Dim AcrobatApp As Acrobat.AcroApp
Dim AcrobatDocument As Acrobat.AcroAVDoc
Dim pdfDoc As Acrobat.AcroPDDoc
Dim Rect As Acrobat.AcroRect
Dim numPages As Integer
Dim Text As String
On Error Resume Next
Set AcrobatApp = CreateObject("AcroExch.App")
Set AcrobatDocument = CreateObject("AcroExch.AVDoc")
Set pdfDoc = CreateObject("AcroExch.PDDoc")
Set Rect = CreateObject("AcroExch.Rect")
Rect.Top = 725 'Bigger seems to be better
Rect.Left = 50 'Lower seems to be better
Rect.Right = 440 'Bigger seems to be better
Rect.bottom = 50 'Lower seems to be better
If AcrobatDocument.Open("C:\Users\42RDO\Desktop\Page 17 10+.pdf", "") Then
AcrobatApp.Show
numPages = pdfDoc.GetNumPages
For i = 1 To numPages
Text = pdfDoc.CreateTextSelect(i, Rect) 'tried to do it by putting the text in a string and then setting Cell Value to be Text but didn't work
SendKeys ("^c"), True
ActiveCell.Offset(1, 0).Select
SendKeys ("^v"), True
Next i
Else
MsgBox PDFPath & " - File not found"
Exit Sub
End If
AcrobatApp.Exit
Set AcrobatApp = Nothing
Set AcrobatDocument = Nothing
End Sub