Открыть файл pdf vba excel

asked Oct 4, 2013 at 15:36

Use Shell "program file path file path you want to open".

Example:

Shell "c:windowssystem32mspaint.exe c:usersadminx.jpg"

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)AdobeAcrobat Reader DCReaderAcroRd32.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

answered Nov 17, 2017 at 17:57

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...DocumentsThis-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

answered Jul 12, 2019 at 16:13

I have code below, it seems to not be opening the pdf please help. I am very fluent with VBA but not with vba object orientated code with adobe.

Option Explicit
Option Compare Text

Sub SeperatePDFFile()

Dim selectpdf As String
Dim caption As String
Dim filter As String
Dim gApp As Acrobat.AcroApp
Dim gPDDoc As Acrobat.AcroPDDoc

Set gApp = CreateObject("AcroExch.App")
Set gPDDoc = CreateObject("AcroExch.PDDoc")

caption = "Please Select an input file must extension .pdf"
selectpdf = Application.GetOpenFilename(filter, , caption)

gPDDoc.Open (selectpdf)

End Sub