[英]Open a PDF using VBA in Excel
我正在尝试使用 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
如果只是打开 PDF 发送一些密钥给它,那为什么不试试这个
Sub Sample()
ActiveWorkbook.FollowHyperlink "C:\MyFile.pdf"
End Sub
我假设您安装了一些 pdf 阅读器。
使用Shell "program file path file path you want to open"
。
示例:
Shell "c:\windows\system32\mspaint.exe c:users\admin\x.jpg"
希望这会有所帮助。 我能够从一个文件夹的所有子文件夹中打开 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 复制到启用宏的工作簿,您可能需要根据您的要求进行微调
问候, 赫玛·卡斯图里
哇...感谢,我添加了一些代码,用于查找 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
谢谢你的代码,这不是我想要的,但可以适合我。
这是此脚本的简化版本,用于将 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.