Question

我正在尝试使用VBA打开与我的Excel工作簿位于同一目录中的所有相应PDF。我已将Adobe Acrobat xx.x类型库引用添加到项目中。但是当我尝试创建.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文件，并使用上面推荐的shell将内容复制到启用宏的工作簿。请参阅下面的代码。

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复制到支持宏的工作簿，你可能需要根据你的要求进行微调

此致赫马卡斯图里

Answer 4

哇... 赞赏地，我添加了一些代码来查找ADOBE的路径

Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
    (ByVal lpFile As String, _
     ByVal lpDirectory As String, _
     ByVal lpResult As String) As Long

并调用它以找到适用的程序名称

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

谢谢您的代码，这不是我想要的，但可以为我改编。

Answer 5

这是此脚本的简化版本，可将pdf复制到XL文件中。


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

在excel中使用vba打开pdf

5 个答案: