Open pdf with vba in excel

Question

I am trying to open all suitable PDF files found in the same directory as my Excel workbook using VBA. I added a link to the Adobe Acrobat xx.x Type Library in the project. But when I try to create the .App object, I get the error "Runtime Error" 429 ":".

What am I missing?

Here is 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 you just need to open the PDF to send some keys, then why not try this

 Sub Sample() ActiveWorkbook.FollowHyperlink "C:\MyFile.pdf" End Sub 

I assume you have some kind of 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 managed to open pdf files from all subfolders of the folder and copy the contents to a macro-enabled workbook using the shell, as recommended above. Please see below 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 a code snippet for copying from pdf and csv to a macro-enabled workbook, and you may need to tweak it to your requirements.

Regards, Hema Kasturi

Answer 4

WOW ... In gratitude, I am adding some 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 to find the name of a suitable program

 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 

Thanks for your code, which is not exactly what I wanted, but can be adapted for me.

Answer 5

Here is a simplified version of this script to copy PDF to 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