@Fennek:
Genau da wollen wir hin ;)
Code:
Option Explicit
Const sPFADEXEFILE As String = "C:\Test\xpdf-tools-win-4.02\bin32\pdftotext.exe" '<--- anpassen; Pfad zur Pdftotext.exe
Sub main()
Dim f As Scripting.File
Dim fso As New Scripting.FileSystemObject
Dim sFile As String
With fso.GetFolder("C:\Test\PDF\") '<--- anpassen; Pfad mit den PDFs
For Each f In .Files
If InStr(1, f.Path, ".pdf", vbTextCompare) > 0 Then
fGetPDFText sPFADEXEFILE, f.Path, Replace(f.Path, ".pdf", ".txt")
End If
Next f
End With
End Sub
Public Function fGetPDFText(ByVal sExecuteFile As String, _
ByVal sSourcePDF As String, _
ByVal sTargetTXT As String) As Boolean
'// ------------------------------------------------------------------------------------
'// Methode: | Erzeugen einer Textdatei aus einem PDF-Dokument
'// ------------------------------------------------------------------------------------
'// Parameter: | sExecuteFile - vollständiger Pfad der pdftotext.exe
'// | sSourcePDF - vollständiger Pfad des Quelldokumentes (PDF)
'// | sTargetTXT - vollständiger Pfad des Zieldokumentes (TXT)
'// ------------------------------------------------------------------------------------
'// Rückgabe: | True bei Erfolg
'// ------------------------------------------------------------------------------------
'// Autor: | ebs17
'// ------------------------------------------------------------------------------------
'// Hinweis: | pdftotext.exe beziehbar über http://www.foolabs.com/xpdf/download.html
'// | aktueller Download zum 18.01.2011:
'// | ftp://ftp.foolabs.com/pub/xpdf/xpdf-3.02pl5-win32.zip
'// ------------------------------------------------------------------------------------
Dim sCommand As String
Dim vResult As Variant
sCommand = sExecuteFile & " -raw " & sSourcePDF & " " & sTargetTXT
vResult = Shell(sCommand, vbHide)
fGetPDFText = Not IsNull(vResult)
End Function
Sub main2()
Dim s As String
Dim v
Dim f As Scripting.File
Dim fso As New Scripting.FileSystemObject
Dim FF As Integer: FF = FreeFile
With fso.GetFolder("C:\Test\TXT\") '<--- anpassen; Pfad zu den TXT
For Each f In .Files
Open f.Path For Binary As FF
s = Space$(LOF(FF))
Get #FF, , s
Close FF
v = Split(s, vbCrLf)
'*** Daten eintragen
With Worksheets(1).Cells(Rows.Count, 1).End(xlUp)
.Offset(1).Value = f.Path
.Offset(1, 1).Value = v(1) '<--- Zeilen der TXT
.Offset(1, 2).Value = v(2) '<--- Zeilen der TXT
End With
Next f
End With
End Sub
Vorgehensweise:
- PDFtoText runterladen extrahieren
- den Pfad im Code anpassen
- alle PDFs unter C:\Test\PDF\ ablegen
- Prozedur main() ausführen
- in C:\Test\PDF\ nun alle txt-Files ausschneiden
- in c:\Test\TXT\ einfügen
ab hier entweder mit main2() weitermachen (dazu müsste man aber weitere PDFs analysieren; Stichwort: 2-3 Positionen auf einem PDF -> gibt Dein Beispiel nicht her)
Oder aber, was für Dich wesentlich praktikabler wäre, ist der Einsatz von PowerQuery.
Da klickst Du das begehrte dann zusammen.
Eine gute Seite zum einlesen wäre m.E. diese hier:
PQ-Import en détail | Excel ist sexy! (excel-ist-sexy.de)Oder Günther meldet sich selbst zu Wort, dann lerne Ich in Sachen PQ auch mal wieder was dazu ;)
Edit:
Sehe eben, dass ich stur aus einem Projekt kopierte.
Bevor Du den Code zum laufen bekommst, musst im Visual Basic Editor noch einen Verweis setzen.
Starte Excel -> Alt+F11 -> Extras -> Verweise -> M$ Scripting Runtime suchen -> anhaken -> mit OK bestätigen.
Ist zwar umständlicher als LateBinding, aber komfortabler für Dich/Euch, falls Ihr Änderungen vornehmen wollt/müsst.
