Daten aus PDF auslesen
Theo
Hallo zusammen,
ich habe zwar schon kräftig gegoogelt, irgendwie finde ich aber noch nicht den richtigen Weg. Ich muss Daten aus vielen PDF files auslesen. Die PDF Files sind zumindest für das menschliche Auge eigentlich identisch aufgebaut (im Prinzip eine Tabelle), kann aber manchmal auch mehr als eine Seite beiinhalten. Mit PowerQuery konnte ich das aufzeichnen und habe letztendlich auch eine Funktion hinbekommen, die bei mir mit 90% der PDF Files funktioniert. Die Funktion versagt lediglich wenn mehr als eine Seite importiert werden muss. Gibte es eine Möglichkeit meinen Code etwas "generischer" zu gestalten, so dass er auch funktioniert wenn das Format des PDF Files sich ändert (zb mehr Spalten, mehr Seiten etc)
Function GetDataFromPDF(StrPDFPath As String) As Boolean
On Error Resume Next
ActiveWorkbook.Queries("Page001").Delete
Tbl_page1.Cells.Clear
Tbl_page2.Cells.Clear
Tbl_page3.Cells.Clear
On Error GoTo DidNotWork
ActiveWorkbook.Queries.Add Name:="Page001", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""" & StrPDFPath & """), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Page1 = Source{[Id=""Page001""]}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Page1,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5""," & _
" type text}, {""Column6"", type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
With Tbl_page1.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Page001;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Page001]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Page001_2"
.Refresh BackgroundQuery:=False
End With
GetDataFromPDF = True
DidNotWork:
End Function
Danke für Eure Hilfe!
Theo