Open a PDF using VBA in Excel - pdf

Question

I'm trying to open all appropriate PDFs found in the same directory as my Excel workbook using VBA. I've added the Adobe Acrobat xx.x Type Library reference to the project. But when I try to create the .App object I get a "Run-time error '429':" error.
What am I missing?
Here's the code;
Sub ImportNames()
Dim BlrInfoFileList() As String, NbrOfFiles As Integer, FileNameStr As String
Dim X As Integer, pdfApp As AcroApp, pdfDoc As AcroAVDoc
'Find all of the Contact Information PDFs
FileNameStr = Dir(ThisWorkbook.Path & "\*Contact Information.pdf")
NbrOfFiles = 0
Do Until FileNameStr = ""
NbrOfFiles = NbrOfFiles + 1
ReDim Preserve BlrInfoFileList(NbrOfFiles)
BlrInfoFileList(NbrOfFiles) = FileNameStr
FileNameStr = Dir()
Loop
For X = 1 To NbrOfFiles
FileNameStr = ThisWorkbook.Path & "\" & BlrInfoFileList(X)
Set pdfApp = CreateObject("AcroExch.App")
pdfApp.Hide
Set pdfDoc = CreateObject("AcroExch.AVDoc")
pdfDoc.Open FileNameStr, vbNormalFocus
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
ThisWorkbook.Sheets("Raw Data").Range("A1").Select
SendKeys ("^v")
Set pdfApp = Nothing
Set pdfDoc = Nothing
'Process Raw Data and Clear the sheet for the next PDF Document
Next X
End Sub

Answer 1

If it's a matter of just opening PDF to send some keys to it then why not try this
Sub Sample()
ActiveWorkbook.FollowHyperlink "C:\MyFile.pdf"
End Sub
I am assuming that you have some pdf reader installed.

Answer 2

Use Shell "program file path file path you want to open".
Example:
Shell "c:\windows\system32\mspaint.exe c:users\admin\x.jpg"

Answer 3

Hope this helps. I was able to open pdf files from all subfolders of a folder and copy content to the macro enabled workbook using shell as recommended above.Please see below the code .
Sub ConsolidateWorkbooksLTD()
Dim adobeReaderPath As String
Dim pathAndFileName As String
Dim shellPathName As String
Dim fso, subFldr, subFlodr
Dim FolderPath
Dim Filename As String
Dim Sheet As Worksheet
Dim ws As Worksheet
Dim HK As String
Dim s As String
Dim J As String
Dim diaFolder As FileDialog
Dim mFolder As String
Dim Basebk As Workbook
Dim Actbk As Workbook
Application.ScreenUpdating = False
Set Basebk = ThisWorkbook
' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
MsgBox diaFolder.SelectedItems(1) & "\"
mFolder = diaFolder.SelectedItems(1) & "\"
Set diaFolder = Nothing
Set fso = CreateObject("Scripting.FileSystemObject")
Set FolderPath = fso.GetFolder(mFolder)
For Each subFldr In FolderPath.SubFolders
subFlodr = subFldr & "\"
Filename = Dir(subFldr & "\*.csv*")
Do While Len(Filename) > 0
J = Filename
J = Left(J, Len(J) - 4) & ".pdf"
Workbooks.Open Filename:=subFldr & "\" & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Set Actbk = ActiveWorkbook
s = ActiveWorkbook.Name
HK = Left(s, Len(s) - 4)
If InStrRev(HK, "_S") <> 0 Then
HK = Right(HK, Len(HK) - InStrRev(HK, "_S"))
Else
HK = Right(HK, Len(HK) - InStrRev(HK, "_L"))
End If
Sheet.Copy After:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = HK
' Open pdf file to copy SIC Decsription
pathAndFileName = subFlodr & J
adobeReaderPath = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
shellPathName = adobeReaderPath & " """ & pathAndFileName & """"
Call Shell( _
pathname:=shellPathName, _
windowstyle:=vbNormalFocus)
Application.Wait Now + TimeValue("0:00:2")
SendKeys "%vpc"
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:2")
' send key to copy
SendKeys "^c"
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' activate this workook and paste the data
ThisWorkbook.Activate
Set ws = ThisWorkbook.Sheets(HK)
Range("O1:O5").Select
ws.Paste
Application.Wait Now + TimeValue("00:00:3")
Application.CutCopyMode = False
Application.Wait Now + TimeValue("00:00:3")
Call Shell("TaskKill /F /IM AcroRd32.exe", vbHide)
' send key to close pdf file
SendKeys "^q"
Application.Wait Now + TimeValue("00:00:3")
Next Sheet
Workbooks(Filename).Close SaveAs = True
Filename = Dir()
Loop
Next
Application.ScreenUpdating = True
End Sub
I wrote the piece of code to copy from pdf and csv to the macro enabled workbook and you may need to fine tune as per your requirement
Regards,
Hema Kasturi

Answer 4

WOW...
In appreciation, I add a bit of code that I use to find the path to ADOBE
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal lpResult As String) As Long
and call this to find the applicable program name
Public Function GetFileAssociation(ByVal sFilepath As String) As String
Dim i As Long
Dim E As String
GetFileAssociation = "File not found!"
If Dir(sFilepath) = vbNullString Or sFilepath = vbNullString Then Exit Function
GetFileAssociation = "No association found!"
E = String(260, Chr(0))
i = FindExecutable(sFilepath, vbNullString, E)
If i > 32 Then GetFileAssociation = Left(E, InStr(E, Chr(0)) - 1)
End Function
Thank you for your code, which isn't EXACTLY what I wanted, but can be adapted for me.

Answer 5

Here is a simplified version of this script to copy a pdf into a XL file.
Sub CopyOnePDFtoExcel()
Dim ws As Worksheet
Dim PDF_path As String
PDF_path = "C:\Users\...\Documents\This-File.pdf"
'open the pdf file
ActiveWorkbook.FollowHyperlink PDF_path
SendKeys "^a", True
SendKeys "^c"
Call Shell("TaskKill /F /IM AcroRd32.exe", vbHide)
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Activate
ws.Range("A1").ClearContents
ws.Range("A1").Select
ws.Paste
Application.ScreenUpdating = True
End Sub