J'essaie d'extraire les données d'un document PDF dans une feuille de calcul. Le format PDF et le texte peuvent être copiés et collés manuellement dans le document Excel.
Je le fais actuellement via SendKeys et cela ne fonctionne pas. Un message d'erreur s'affiche lorsque j'essaie de coller les données du document PDF. Pourquoi ma pâte ne fonctionne pas? Si je colle après que la macro a cessé de fonctionner, elle se colle normalement.
Dim myPath As String, myExt As String
Dim ws As Worksheet
Dim openPDF As Object
'Dim pasteData As MSForms.DataObject
Dim fCell As Range
'Set pasteData = New MSForms.DataObject
Set ws = Sheets("DATA")
If ws.Cells(ws.Rows.Count, "A").End(xlUp).Row > 1 Then Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).ClearContents
myExt = "\*.pdf"
'When Scan Receipts Button Pressed Scan the selected folder/s for receipts
For Each fCell In Range(ws.Cells(1, 1), ws.Cells(1, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column))
myPath = Dir(fCell.Value & myExt)
Do While myPath <> ""
myPath = fCell.Value & "\" & myPath
Set openPDF = CreateObject("Shell.Application")
openPDF.Open (myPath)
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a"
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
'Application.Wait Now + TimeValue("00:00:2")
ws.Select
ActiveSheet.Paste
'pasteData.GetFromClipboard
'ws.Cells(3, 1) = pasteData.GetText
Exit Sub
myPath = Dir
Loop
Next fCell
Vous pouvez ouvrir le fichier PDF et en extraire le contenu à l'aide de la bibliothèque Adobe (que vous pouvez télécharger à partir d'Adobe dans le cadre du SDK, mais il est fourni avec certaines versions d'Acrobat également).
Assurez-vous également d'ajouter la bibliothèque à vos références (sur ma machine, il s'agit de la bibliothèque de types Adobe Acrobat 10.0, mais vous ne savez pas s'il s'agit de la version la plus récente).
Même avec la bibliothèque Adobe, ce n’est pas trivial (vous aurez besoin d’ajouter votre propre trapping des erreurs, etc.):
Function getTextFromPDF(ByVal strFilename As String) As String
Dim objAVDoc As New AcroAVDoc
Dim objPDDoc As New AcroPDDoc
Dim objPage As AcroPDPage
Dim objSelection As AcroPDTextSelect
Dim objHighlight As AcroHiliteList
Dim pageNum As Long
Dim strText As String
strText = ""
If (objAvDoc.Open(strFilename, "") Then
Set objPDDoc = objAVDoc.GetPDDoc
For pageNum = 0 To objPDDoc.GetNumPages() - 1
Set objPage = objPDDoc.AcquirePage(pageNum)
Set objHighlight = New AcroHiliteList
objHighlight.Add 0, 10000 ' Adjust this up if it's not getting all the text on the page
Set objSelection = objPage.CreatePageHilite(objHighlight)
If Not objSelection Is Nothing Then
For tCount = 0 To objSelection.GetNumText - 1
strText = strText & objSelection.GetText(tCount)
Next tCount
End If
Next pageNum
objAVDoc.Close 1
End If
getTextFromPDF = strText
End Function
Ce que vous faites est essentiellement la même chose que vous essayez de faire - en utilisant uniquement la propre bibliothèque d’Adobe. Il parcourt PDF une page à la fois, met en surbrillance tout le texte de la page, puis le dépose (un élément de texte à la fois) dans une chaîne.
N'oubliez pas que ce que vous obtenez peut contenir toute une gamme de caractères non imprimables (sauts de ligne, nouvelles lignes, etc.) qui peuvent même se retrouver au milieu de ce qui ressemble à des blocs de texte contigus. nettoyer avant de pouvoir l'utiliser.
J'espère que cela pourra aider!
L'émulation des interactions utilisateur entre copier et coller peut ne pas être fiable (par exemple, une fenêtre contextuelle apparaît et le focus est activé). Vous voudrez peut-être essayer le ByteScout PDF commercial SDK extracteur qui est spécialement conçu pour extraire les données de PDF et fonctionne à partir de VBA. Il est également capable d'extraire des données de factures et de tableaux au format CSV à l'aide du code VB .
Voici le code VBA pour Excel permettant d’extraire du texte à partir d’emplacements donnés et de les enregistrer dans des cellules du Sheet1
:
Private Sub CommandButton1_Click()
' Create TextExtractor object
' Set extractor = CreateObject("Bytescout.PDFExtractor.TextExtractor")
Dim extractor As New Bytescout_PDFExtractor.TextExtractor
extractor.RegistrationName = "demo"
extractor.RegistrationKey = "demo"
' Load sample PDF document
extractor.LoadDocumentFromFile ("c:\sample1.pdf")
' Get page count
pageCount = extractor.GetPageCount()
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
For i = 0 To pageCount - 1
RectLeft = 10
RectTop = 10
RectWidth = 100
RectHeight = 100
' check the same text is extracted from returned coordinates
extractor.SetExtractionArea RectLeft, RectTop, RectWidth, RectHeight
' extract text from given area
extractedText = extractor.GetTextFromPage(i)
' insert rows
' Rows(1).Insert shift:=xlShiftDown
' write cell value
Set TxtRng = ws.Range("A" & CStr(i + 2))
TxtRng.Value = extractedText
Next
Set extractor = Nothing
End Sub
Divulgation: je suis lié à ByteScout
Au fil du temps, j'ai constaté que l'extraction de texte à partir de PDF dans un format structuré était une tâche difficile. Toutefois, si vous recherchez une solution simple, envisagez d'utiliser XPDF tool pdftotext
.
Le pseudocode pour extraire le texte comprendrait:
Shell
VBA pour extraire le texte de PDF dans un fichier temporaire à l'aide de XPDFExemple simplifié ci-dessous:
Sub ReadIntoExcel(PDFName As String)
'Convert PDF to text
Shell "C:\Utils\pdftotext.exe -layout " & PDFName & " tempfile.txt"
'Read in the text file and write to Excel
Dim TextLine as String
Dim RowNumber as Integer
Dim F1 as Integer
RowNumber = 1
F1 = Freefile()
Open "tempfile.txt" for Input as #F1
While Not EOF(#F1)
Line Input #F1, TextLine
ThisWorkbook.WorkSheets(1).Cells(RowNumber, 1).Value = TextLine
RowNumber = RowNumber + 1
Wend
Close #F1
End Sub
Etant donné que je ne préfère pas utiliser de bibliothèques externes et/ou d’autres programmes, j’ai étendu votre solution pour qu’elle fonctionne. Le changement actuel utilise la fonction GetFromClipboard au lieu de Paste, qui est principalement utilisé pour coller une plage de cellules . Bien sûr, l’inconvénient est que l’utilisateur ne doit pas changer de focus ni intervenir pendant tout le processus.
Dim pathPDF As String, textPDF As String
Dim openPDF As Object
Dim objPDF As MsForms.DataObject
pathPDF = "C:\some\path\data.pdf"
Set openPDF = CreateObject("Shell.Application")
openPDF.Open (pathPDF)
'TIME TO WAIT BEFORE/AFTER COPY AND PASTE SENDKEYS
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a"
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:1")
AppActivate ActiveWorkbook.Windows(1).Caption
objPDF.GetFromClipboard
textPDF = objPDF.GetText(1)
MsgBox textPDF
Si vous êtes intéressé, voyez mon projet dans github .
Pour améliorer la solution de Slinky Sloth, j'ai dû ajouter ceci avant le presse-papier:
Set objPDF = New MSForms.DataObject
Malheureusement, cela n'a pas fonctionné pour un pdf de 10 pages.
Utiliser Bytescout PDF Extractor SDK est une bonne option. Il est bon marché et offre de nombreuses fonctionnalités liées à PDF. Une des réponses ci-dessus pointe vers la page morte Bytescout sur GitHub. Je fournis un échantillon de travail pertinent pour extraire un tableau à partir de PDF. Vous pouvez l'utiliser pour exporter dans n'importe quel format.
Set extractor = CreateObject("Bytescout.PDFExtractor.StructuredExtractor")
extractor.RegistrationName = "demo"
extractor.RegistrationKey = "demo"
' Load sample PDF document
extractor.LoadDocumentFromFile "../../sample3.pdf"
For ipage = 0 To extractor.GetPageCount() - 1
' starting extraction from page #"
extractor.PrepareStructure ipage
rowCount = extractor.GetRowCount(ipage)
For row = 0 To rowCount - 1
columnCount = extractor.GetColumnCount(ipage, row)
For col = 0 To columnCount-1
WScript.Echo "Cell at page #" +CStr(ipage) + ", row=" & CStr(row) & ", column=" & _
CStr(col) & vbCRLF & extractor.GetCellValue(ipage, row, col)
Next
Next
Next
De nombreux autres exemples sont disponibles ici: https://github.com/bytescout/pdf-extractor-sdk-samples