открыть pdf с помощью vba в excel

Question

Я пытаюсь открыть все подходящие PDF-файлы, найденные в том же каталоге, что и моя книга Excel, используя VBA. Я добавил в проект ссылку на библиотеку Adobe Acrobat xx.x Type Library. Но когда я пытаюсь создать объект .App, я получаю ошибку «Ошибка выполнения» 429 «:».

Что мне не хватает?

Вот код;

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

Если это вопрос просто открытия PDF, чтобы отправить некоторые ключи к нему, то почему бы не попробовать этот

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

Я предполагаю, что у вас установлен какой-то читатель PDF.

Answer 2

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

Пример:

Shell "c:\windows\system32\mspaint.exe c:users\admin\x.jpg" 

Answer 3

Надеется, что это помогает. Я смог открыть pdf-файлы из всех подпапок папки и скопировать содержимое в рабочую книгу с поддержкой макросов, используя оболочку, как рекомендовано выше. Пожалуйста, смотрите ниже код.

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 

я написал кусок кода, чтобы скопировать из PDF и CSV в макро включен книгу, и вы, возможно, потребуется для точной настройки в соответствии с вашими требованиями

С уважением, Хема Кастури