J'essaie d'ouvrir tous les fichiers PDF appropriés trouvés dans le même répertoire que mon classeur Excel à l'aide de VBA. J'ai ajouté la référence de bibliothèque de types Adobe Acrobat xx.x au projet. Mais lorsque j'essaie de créer l'objet .App, j'obtiens une erreur "Erreur d'exécution '429':".
Qu'est-ce que je rate?
Voici le 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
S'il s'agit simplement d'ouvrir PDF pour lui envoyer des clés, alors pourquoi ne pas essayer ceci
Sub Sample()
ActiveWorkbook.FollowHyperlink "C:\MyFile.pdf"
End Sub
Je suppose que vous avez installé un lecteur pdf.
Utilisation Shell "program file path file path you want to open"
.
Exemple:
Shell "c:\windows\system32\mspaint.exe c:users\admin\x.jpg"
WOW ... En appréciation, j'ajoute un peu de code que j'utilise pour trouver le chemin vers Adobe
Private Declare Function FindExecutable Lib "Shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal lpResult As String) As Long
et appelez-le pour trouver le nom du programme applicable
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
Merci pour votre code, qui n'est pas exactement ce que je voulais, mais qui peut être adapté pour moi.
J'espère que cela t'aides. J'ai pu ouvrir des fichiers pdf à partir de tous les sous-dossiers d'un dossier et copier le contenu dans le classeur compatible avec les macros à l'aide de Shell comme recommandé ci-dessus.Veuillez voir ci-dessous le 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
J'ai écrit le morceau de code à copier du pdf et du csv vers le classeur activé par macro et vous devrez peut-être affiner selon vos besoins
Cordialement, Hema Kasturi
Voici une version simplifiée de ce script pour copier un pdf dans un fichier EXCEL.
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