bob1986
Goto Top

Pdf auslesen und in excel schreiben

schonen guten tag alle

erst mal mochte ich mich entschuldigen fur meine schreibfehler

ich kan auch keine a,o,u, punkten verwenden

ich hoffe jemand kan mir helfen bei meinen folgenden problem

ich suche ein vbscript oder adere moglichkeit wie ich daten aus einen adobe acrobat bestand '' die ich via e-mail bekomme ''

wen ich diesen bestand aufmache mochte ich das der vbscript eine bestimte stelle sucht im blad diesen kopiert und in einen bestimmten excel bestand kopiert in den excel bestand soll das dan immer in reie A untereinandern geschriedern werden beispiel; reie A1 A2 A3 A4 und so weiter

der vbscript soll dan im adobe acrobat eine blad weiter blettern und wieder das gleiche ausfuren eine bestimte stelle suchen diese kopieren und in den oben genanten excel bestand kopieren z.b. A2 das soll der vbscript dan so lange machen bis der bestand zum letzten blatt gekommen ist

der bestand wird jedentag mit unterschiedlichen blattseiten empfangen via e-mail als pdf bestand ich habe selbst auf meinen computer ein adobe acrobat programa

ich hoffe jemand kan mir hierbei helfen mit einer oder einer anderen moglichkeit

vielendank schonmal fur antworten auf meine frage

und entschuldige fur die rechtschreibung

mvg

bob

Content-Key: 183617

Url: https://administrator.de/contentid/183617

Printed on: April 19, 2024 at 23:04 o'clock

Member: NetWolf
NetWolf Apr 17, 2012 at 11:19:42 (UTC)
Goto Top
Hallo Bob,

welches Programm nutzt du denn, wenn du eine Email mit einer PDF als Anhang bekommst?
In welchem Format kommt die PDF - Datei an? Als gescantes Bild, oder als umgewandelte Text-Datei?

Suchst du hier eine fertige Lösung, oder kannst du auch selbst programmieren?

Grüße aus Rostock
Wolfgang
(Netwolf)
Member: bob1986
bob1986 Apr 17, 2012 at 16:58:22 (UTC)
Goto Top
ich habe nicht so viel ervarung mit vbscript nur kleine dinge, wen ich das pdf offne ich das mit adobe acrobat die daten kommen als umgewandelte Text-Datei kopieren kan ich alles von dieser text datei aber ich wurde das gerne automatisieren

ich suche menschen die mich zu einer losung furen, oder die schon sowas gehort haben das das kan und schon vieleicht eine losung fertig haben


danke fur die antwort

mvg


bob
Member: mak-xxl
mak-xxl Apr 19, 2012 at 06:52:46 (UTC)
Goto Top
Moin bob,

- Du möchtest einen oder verschiedene Begriff(e)/String(s) im pdf-Dokument suchen (und finden)?
- wie viele pdf-Dokumente mit wieviel Fundstellen sind es (etwa) in welchem Zeitraum?
- gibt es den gesuchten Begriff/String ein- oder mehrfach im pdf-Dokument?
- muss zu einer Fundstelle eine Seitenreferenz o.ä. gespeichert werden?
- sollen alle Fundstellen in einer oder mehreren xls-Tabellen/Dateien gespeichert werden?
- soll das ganze vollautomatisch nach Zeit, Maileingang oder per Hand gemacht werden?
- welche Excel- bzw. pdf-Versionen stehen zur Verfügung?
- unter welchem OS soll das Ganze laufen?

Freundliche Grüße von der Insel - Mario
Member: facebraker
facebraker Apr 19, 2012 at 07:29:34 (UTC)
Goto Top
Guten Morgen,

ich wäre auch an einer Lösung interessiert, brauche nichts fertiges paar Codeschnipsel reichen mir, habe bisher noch nicht versucht auf eine PDF zuzugreifen.

Gruß Alex
Member: mak-xxl
mak-xxl Apr 19, 2012 at 08:35:32 (UTC)
Goto Top
Moin Alex,

also, das Thema ist insofern etwas komplexer, als da zunächst geklärt werden muss, ob die pdf-Dokumente

- geschützt sind (Zugriff nur über API-Funktionen mit Password etc. möglich);
- als 'Bildersammlung' vorliegen (also aus tiff, jpg etc. bestehen) - dann vorab interne OCR bemühen;
- als indizierbarer Text daherkommen.

Letzteres ist relativ simpel, das pdf-Dokument wird z.B. mit pdf2txt in ASCII/UTF umgewandelt und ist danach selbst mit Batch-Mitteln fast beliebig behandelbar.
Müssen API-Funktionen (bestens beschrieben hier und Download) zur Anwendung kommen, Adobe lässt dafür JavaScript arbeiten - und das ist nun auch wieder beherrschbar. Vielleicht noch dies als Anregung, weitere Fragen sind sehr willkommen.

Freundliche Grüße von der Insel - Mario
Member: facebraker
facebraker Apr 19, 2012 at 08:43:18 (UTC)
Goto Top
Hi Mario,

genial, das SDK ist ja der Hammer!
Aber das iText ist auch nicht zu verachten, vielen Dank für die Tipps!

Gruß Alex
Member: bob1986
bob1986 Apr 22, 2012 at 09:49:55 (UTC)
Goto Top
Zitat von @mak-xxl:
Moin bob,

- Du möchtest einen oder verschiedene Begriff(e)/String(s) im pdf-Dokument suchen (und finden)?
- wie viele pdf-Dokumente mit wieviel Fundstellen sind es (etwa) in welchem Zeitraum?
- gibt es den gesuchten Begriff/String ein- oder mehrfach im pdf-Dokument?
- muss zu einer Fundstelle eine Seitenreferenz o.ä. gespeichert werden?
- sollen alle Fundstellen in einer oder mehreren xls-Tabellen/Dateien gespeichert werden?
- soll das ganze vollautomatisch nach Zeit, Maileingang oder per Hand gemacht werden?
- welche Excel- bzw. pdf-Versionen stehen zur Verfügung?
- unter welchem OS soll das Ganze laufen?

Freundliche Grüße von der Insel - Mario


dankeschon fur die antwort

- in ein pdf dokument ist das immer eine fundstelle, das gilt immer fur ein blatt im pdf
die blatt anzal ist von tag zu tag immer unterschiedlich aber die fundstell immer die gleiche

- den gesuchten begriff gibt es immer nur einmal auf einer blattzeite im pdf dokument
also wen das pdf dokument 50 plattzeiten hat sind es dan 50 kopierte werte in excel wieder zugeben in baltt 1 / A1 BIS
A50

- alle fundstellen sollen in einer reie untereinander im ersten blatt im excel dokument geschrieben werden z.b. blatt1 /
spalte A1 bis A100 .....

- das ganze soll vollautomatisch pasieren wen das pdf dokument aus der email auf den desktop gespeichert worde
oder wen ich z.b. einen knopf im excel oder en vbs auf den desktop starte das der vbs mir dan z.b. das alles kopiert von
den pdf dokument in den excel bestand

wen das moglich ist?


ich habe outlok 2003
excel 2003

adobe acrobat


- unter welchem OS soll das Ganze laufen? ICH WEIS NIET WAS DU MIT OS MEINST

achso das pdf komt geschutzt rein, das einsichste was ich machen kan ist den bestimten wert kopieren und in excel
kopieren

gruse bob
Member: mak-xxl
mak-xxl Apr 22, 2012 at 10:51:34 (UTC)
Goto Top
Moin bob,

Zitat von @bob1986:
> - unter welchem OS soll das Ganze laufen? ICH WEIS NIET WAS DU MIT OS MEINST

Das OS=Operating System, das ist aber durch die Programmangaben (Excel, Outlook) geklärt und ist wohl Windows.

achso das pdf komt geschutzt rein, das einsichste was ich machen kan ist den bestimten wert kopieren und in excel kopieren

Musst Du zum Öffnen der pdf-Datei ein Passwort eingeben?

Nochmals zwei Fragen, die Du noch nicht beantwortet hast:

- wie viele pdf-Dokumente mit wieviel Fundstellen sind es (etwa) in welchem Zeitraum?

Also z.B. 1.000 pdf-Dateien je Tag mit je ca. 500 Fundstellen?

- muss zu einer Fundstelle eine Seitenreferenz o.ä. gespeichert werden?

also etwa in der Art:

Fundstelle Seite xx Dateiname.pdf

Freundliche Grüße von der Insel - Mario
Member: bob1986
bob1986 Apr 22, 2012 at 11:23:08 (UTC)
Goto Top
Zitat von @mak-xxl:
Moin bob,

> Zitat von @bob1986:
> > - unter welchem OS soll das Ganze laufen? ICH WEIS NIET WAS DU MIT OS MEINST

Das OS=Operating System, das ist aber durch die Programmangaben (Excel, Outlook) geklärt und ist wohl Windows.

ja das ist windows


> achso das pdf komt geschutzt rein, das einsichste was ich machen kan ist den bestimten wert kopieren und in excel kopieren

Musst Du zum Öffnen der pdf-Datei ein Passwort eingeben?

ein ich mus kein passwort eingeben zum ofnen das pdf

Nochmals zwei Fragen, die Du noch nicht beantwortet hast:

> - wie viele pdf-Dokumente mit wieviel Fundstellen sind es (etwa) in welchem Zeitraum?

weis nicht ganzgenau wie du es meinst, denke so

ca. +/- 100 blattseiten im pdf dokument wo auf jeden blatt eine stelle kopiert werden muss und in excel abgelegt weden soll

davon bekomme ich jeden tag 2 bis 3 e-mails wo ich das machen muste


Also z.B. 1.000 pdf-Dateien je Tag mit je ca. 500 Fundstellen?

> - muss zu einer Fundstelle eine Seitenreferenz o.ä. gespeichert werden?

weis nicht ganzgenau wie du es meinst

nein es muss niet gespeichert werden

also etwa in der Art:

Fundstelle Seite xx Dateiname.pdf

Freundliche Grüße von der Insel - Mario


danke fur die schnelle antwort

mvg

bob
Member: mak-xxl
mak-xxl Apr 22, 2012 at 13:21:39 (UTC)
Goto Top
Moin bob,

in welcher Form bzw. Schreibweise taucht der Suchbegriff im pdf-Dokument auf?

z.B. so: '<xxx>Suchbegriff<yyy>'?

oder so:'#Suchbegriff#'?

oder so: 'xxx: Suchbegriff'?

oder wie?

Freundliche Grüße von der Insel - Mario
Member: bob1986
bob1986 Apr 22, 2012 at 13:45:35 (UTC)
Goto Top
der zu suchende unterweb steht immer neben diesen satz

Merken en nummers: 158753jgTBS

ich brauche immer die verschiedenen nummer von jeden blad im pdf dokoment die hinter diesem satz stehen Merken en nummers:

die nummer 158753jgTBS sind immer 11 nummer's lang / buchstaben und zahlen


schone gruse bob
Member: mak-xxl
mak-xxl Apr 23, 2012 at 16:58:38 (UTC)
Goto Top
Moin bob,

Du hast eine PM - nachschauen!

Freundliche Grüße von der Insel - Mario
Member: mak-xxl
mak-xxl May 04, 2012 at 14:59:07 (UTC)
Goto Top
Moin @all,

da sich der TO nicht mehr meldet, poste ich die letzte, funktionierende Lösung (für Excel <=2k3), die erstellt wurde. Sie basiert auf dem Tool <pdftotext.exe> aus dem XPDF-Paket, mit dem auch Username & Passwort für geschützte PDFs übergeben werden kann. Der Code kommt in das Modulblatt einer Tabelle oder in ein eigenes Modul. In dem Verzeichnis, in dem die Excel-Mappe steht, muss es ein Verzeichnis '\Tools' mit der <pdftotext.exe> geben (sonst ändern in Zeile 13), ebenso liegen hier die PDFs, die alle durchsucht werden. Die Ausgabe der gefundenen Suchstrings erfolgt in der Spalte 'A', der zugehörige Dateiname wird neben die erste Fundstelle in Spalte 'B' geschrieben.

Sub PDF2Excel()

    Dim i As Integer, z As Long
    Dim strPDFPath As String, strCMDLine As String
    Dim FSO As Object, objWks As Object, WSHShell As Object
    Dim strTXT As String
    
    Set WSHShell = CreateObject("WScript.Shell")  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    Set objWks = ThisWorkbook.Sheets(1)                             ' Ausgabe  
    
    strPDFPath = ThisWorkbook.Path
    strCMDLine = strPDFPath & "\Tools\pdftotext.exe -raw -layout -nopgbrk "  
    
    Const strPrefix As String * 19 = "Merken en nummers: "          ' dahinter steht Suchbegriff  
    Const intSWLen = 11                                             ' "158753jgTBS"  
    
    With Application.FileSearch                                     ' vorhandene pdf-Files ermitteln  
        .NewSearch                                                  ' alles auf Anfang  
        .LookIn = strPDFPath
        .SearchSubFolders = False
        .FileName = "*.pdf"  
'        .LastModified = msoLastModifiedToday                        ' nur aktuelle Dateien  
        .Execute
        For i = 1 To .FoundFiles.Count                              ' in txt umwandeln  
            WSHShell.Run (strCMDLine & Chr(34) & .FoundFiles(i) & Chr(34)), 0, True
'            Kill .FoundFiles(i)                                     ' pdf-Files löschen  
        Next i
        .FileName = "*.txt"                                         ' vorhandene txt-Files ermitteln  
        .Execute
        z = objWks.Cells(Rows.Count, 1).End(xlUp).Row + 1           ' letzte belegte Zeile (Spalte A)  
        For i = 1 To .FoundFiles.Count
            strTXT = FSO.OpenTextFile(.FoundFiles(i)).ReadAll
            objWks.Cells(z, 2) = .FoundFiles(i)                     ' Dateiname in Spalte B  
            While InStr(1, strTXT, strPrefix, vbTextCompare) > 0
                strTXT = Mid(strTXT, InStr(1, strTXT, strPrefix) + Len(strPrefix) - 1)
                objWks.Cells(z, 1) = Left(strTXT, intSWLen)         ' Wert eintragen  
                z = z + 1
            Wend
            Kill .FoundFiles(i)                                     ' txt-Files löschen  
        Next i
    End With
    
End Sub

Der Stríng ('strTXT') wird von links bis inkl. dem Suchstring ('strPrefix') gekürzt (Zeile 36) und danach der zu findende String ebenfalls von links in der Länge(intSWLen) als Fundstelle in das Tabellenblatt eingetragen (Zeile 37), dieses so lange, bis der Suchstring keine Fundstelle mehr hergibt ('While'). Zum Entfernen unliebsamer Zeichen (vbCR o.ä.) bietet sich Zeile 33 per (auch geschachtelter) 'Replace' an.
Wichtig ist, in Zeile 26 auf das Ende des externen Befehls zu warten ('True'), da sonst die txt-Datei eingelesen wird, bevor sie u.U. vollständig geschrieben ist.

[Edit]

Da sich der TO jetzt doch wieder gemeldet hat und auf einem Rechner mittlerweile Office 2010 einsetzt, galt es Abschied vom 'deprecated FileSearch'-Objekt zu nehmen. Die Lösung ersetzt das Objekt nicht, sondern verlagert nur das Einlesen des Verzeichnisses auf WSH. Struktur und Hauptfunktion sonst wie oben:

Sub PDF2Excel()

    Dim i As Integer, z As Long
    Dim strCMDLine As String, strTXT As String
    Dim FSO As Object, objSFold As Object, objWks As Object, WSHShell As Object, tmp As Object
    Dim colPFiles As New Collection, colTFiles As New Collection
    
    Set WSHShell = CreateObject("WScript.Shell")  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    Set objSFold = FSO.GetFolder(ThisWorkbook.Path)
    Set objWks = ThisWorkbook.Sheets(1)                             ' Ausgabe  
    
    strCMDLine = ThisWorkbook.Path & "\Tools\pdftotext.exe -raw -layout -nopgbrk "  
    
    Const strPrefix As String * 19 = "Merken en nummers: "          ' dahinter steht Suchbegriff  
    Const intSWLen = 11                                             ' "158753jgTBS"  
        
    For Each tmp In objSFold.Files                                  ' alle Dateien einlesen  
        If Right(tmp.Path, 4) = ".pdf" Then colPFiles.Add tmp.Path  ' nur *.pdf  
    Next tmp
    
    For i = 1 To colPFiles.Count
         WSHShell.Run (strCMDLine & Chr(34) & colPFiles.Item(i) & Chr(34)), 0, True
'        Kill colPFiles.Item(i)                                      ' pdf-Files löschen  
    Next
    
    For Each tmp In objSFold.Files                                  ' wieder alles einlesen  
        If Right(tmp.Path, 4) = ".txt" Then colTFiles.Add tmp.Path  ' nur *.txt  
    Next tmp
    
    z = objWks.Cells(Rows.Count, 1).End(xlUp).Row + 1               ' letzte belegte Zeile (Spalte A)  
    
    For i = 1 To colTFiles.Count
        strTXT = FSO.OpenTextFile(colTFiles.Item(i)).ReadAll
        objWks.Cells(z, 2) = colPFiles.Item(i)                      ' Dateiname in Spalte B  
        While InStr(1, strTXT, strPrefix, vbTextCompare) > 0
            strTXT = Mid(strTXT, InStr(1, strTXT, strPrefix) + Len(strPrefix) - 1)
            objWks.Cells(z, 1) = Left(strTXT, intSWLen)             ' Wert eintragen  
            z = z + 1
        Wend
        Kill colTFiles.Item(i)                                      ' txt-Files löschen  
    Next
    
End Sub

[/Edit]

@Biber: Vielen Dank für Lob und Wünsche - Dir und allen Anderen ein erholsames Wochenende!

Freundliche Grüße von der Insel - Mario (nunmehr mit stolzgeschwellter Brust ab.)
Member: Biber
Biber May 04, 2012 at 16:14:27 (UTC)
Goto Top
Moin mak-xxl von der Insel Mario,

danke dir für das Bereitstellen deiner sauberen und dokumentierten Lösung.

Wenn wir noch ein paar hundert weitere Insulaner deiner Art hier hätten, dann würde dieses Forum meinem Ideal eines Forums sehr nahe kommen.

Ich setze den Beitrag mal auf "Gelöst".

Schönes und baldiges Wochenende
Biber
Member: bob1986
bob1986 May 04, 2012 at 16:27:15 (UTC)
Goto Top
hallo leute

sorry das ich nicht mehr reagiert habe aber ich bin zur zeit krank und habe viel rucken schmerzen was mir die arbeit sehr erschwert am computer
ich bitte um euer verstandnis in der sache

mvg

bob
Member: Biber
Biber May 04, 2012 at 16:43:46 (UTC)
Goto Top
Moin bob1086,

auch dir danke für deine Rückmeldung.

Und natürlich - falls noch Fragen offen sind - kannst du in diesem Beitrag auch weiterhin schreiben und fragen.

Auch die ein schönes Wochenende
Biber
Member: Abfelpaum
Abfelpaum Nov 16, 2015 at 15:18:53 (UTC)
Goto Top
Hallo mak-xxl,

ich bin begeistert, das klappt wunderbar.

Leider will ich aber nicht etwas auslesen was hinter "Merken en nummers: " steht, sondern etwas anderes.

Bei mir geht es darum, Flächen auszulesen. Die Form ist immer die gleiche, zum Beispiel: 35,63 m². Manchmal auch über 100 m². Also ich würde gerne aus dem pdf alles auslesen, was die Form "???,?? m²" hat. Ich hab es probiert, leider nicht hinbekommen.

Bitte um Hilfe, würd mich sehr freuen!

Liebe Grüße,
Peter
Member: mak-xxl
mak-xxl Nov 19, 2015, updated at Nov 23, 2015 at 09:18:19 (UTC)
Goto Top
Hallo Peter,

es ist ein relativ alter Thread, den Du hier ausgegraben hast.

Ich beziehe mich in der Folge auf meinen Post vom 04.05.2012 um 16:59 Uhr, speziell auf den 2. Block.

In Zeile 15 muss der String eingegeben werden, hinter dem der benötigte String steht, also etwa "Fläche: "

In Zeile 16 wird die Länge des gesuchten Strings eingetragen, bei '100,00 m²' also '9'. Da die zu ermittelnde Fläche eine unterschiedliche Größe hat, muss hier die größte zu erwartende Stringlänge eingetragen werden (also für 9999,99 m² = '10').

Da aber jetzt kleinere Flächenwerte unter Umständen (wenn nicht nach der Angabe 'm²' etwa ein Zeilenumbruch steht) mit 'Anhang' eingelesen werden (also etwa '1,22 m²xxx' (10 Stellen)), kann man den ausgelesenen String nach Zeile 38 nachbearbeiten, etwa so:
objWks.Cells(z, 1) = Replace(objWks.Cells(z, 1); "m²*", "m²")   
oder, falls nur Buchstaben nachfolgen und der reine Flächenwert ohne Einheit gewünscht ist:
objWks.Cells(z, 1) = Var(objWks.Cells(z, 1)) 

Ich hoffe, das reicht als Anregung, sonst nochmals melden.

Freundliche Grüße von der Insel - Mario

[Edit]

Statt mit 'Var(Zelle)' muss das natürlich mit 'Val(Zelle)' erfolgen ...

[/Edit]
Member: Abfelpaum
Abfelpaum Nov 21, 2015 at 10:52:32 (UTC)
Goto Top
Hallo Mario,

da hab ich mich wohl nicht genau genug ausgedrückt. Es geht nicht darum einen Ausdruck hinter einem anderen zu finden. Die Flächen, die ich brauche sind wild verteilt und nicht immer hinter dem gleichen Ausdruck.

Kann man dein Makro ohne viel Aufwand so umschreiben, dass er mir jeden Text ausliest, der so aussieht: "???,?? m²". (also unabhängig davon, wo er steht.

Danke schon mal für deine Antwort, freu mich sehr, dass dieser Thread noch nicht verwaist ist.

Liebe Grüße,
Peter
Member: mak-xxl
mak-xxl Nov 23, 2015 at 10:08:24 (UTC)
Goto Top
Hallo Peter,

eine Möglichkeit, das Ganze in diesem Sinne anzupassen, basiert auf folgender Überlegung:
- irgendwo im Text steht 'm²'
- dann sind max. 8 Stellen davor die zugehörigen Werte zu finden (i.e. '1234,56 [m²])
- es wird im Text der String 'm²' gesucht
- wenn vorhanden, dann Stelle (des 'm') merken
- im Gesamtstring 8 Zeichen rückwärts gehen
- ab hier 10 Zeichen auslösen (i.e. '1234,56 m²')
- da jetzt (bei kleineren m²-Werten) auch Nicht-Zahlen erfasst werden (können), ist der Wert entsprechend nachzubehandeln (siehe letzter Post, allerdings mit Val(Zelle) - das habe ich oben korrigiert.

Der Code wäre in etwa so anzupassen:

Zeile 15:
Const strSW As String * 2 = "m²"          ' der Suchbegriff  

Zeile 16:
Const strSWlen  = 8                       ' der Wert [für 9.999,00 m²]  

Zeile 36:
While InStr(1, strTXT, strSW, vbTextCompare) > 0        ' m²  ist drin  

Zeile 37:
strTXT = Mid(strTXT, InStr(1, strTXT, strSW) - intSWlen)

Zeile 38:
objWks.Cells(z, 1) = Left(strTXT, intSWLen)             ' Wert eintragen  

Jetzt muss eine Zeile eingefügt werden, die aus dem Gesamtstring ('strTXT') den soeben gefundenen Teilstring löscht, sonst gibt es eine Endlosschleife:

Zeile 39:
strTXT = Mid(strTXT, InStr(1, strTXT, strSW) + 2)

Der Code ist keineswegs optimal (Mehrfachaufruf von Funktionen), aber für das Verständnis vielleicht besser. Bei großen und/oder vielen pdf-Files muss das dann gestrafft werden.

Ein Hinweis: Der Suchstring 'm²' kann evtl. im pdf-File anders kodiert sein (i.e. 'm<sup>2</sup>'), hier hilft ein Blick mit dem Editor in die Datei.

Freundliche Grüße von der Insel - Mario
Member: Abfelpaum
Abfelpaum Nov 23, 2015 at 11:47:17 (UTC)
Goto Top
Lieber Mario,
ich habe den Code jetzt so angepasst:

Sub PDF2Excel()

Dim i As Integer, z As Long
Dim strCMDLine As String, strTXT As String
Dim FSO As Object, objSFold As Object, objWks As Object, WSHShell As Object, tmp As Object
Dim colPFiles As New Collection, colTFiles As New Collection

Set WSHShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objSFold = FSO.GetFolder(ThisWorkbook.Path)
Set objWks = ThisWorkbook.Sheets(1) ' Ausgabe

strCMDLine = ThisWorkbook.Path & "\Tools\pdftotext.exe -raw -layout -nopgbrk "

Const strSW As String * 2 = "m²" ' der Suchbegriff
Const strSWlen = 9 ' der Wert [für 9.999,00 m²]

For Each tmp In objSFold.Files ' alle Dateien einlesen
If Right(tmp.Path, 4) = ".pdf" Then colPFiles.Add tmp.Path ' nur *.pdf
Next tmp

For i = 1 To colPFiles.Count
WSHShell.Run (strCMDLine & Chr(34) & colPFiles.Item(i) & Chr(34)), 0, True
'Kill colPFiles.Item(i) ' pdf-Files löschen
Next

For Each tmp In objSFold.Files ' wieder alles einlesen
If Right(tmp.Path, 4) = ".txt" Then colTFiles.Add tmp.Path ' nur *.txt
Next tmp

z = objWks.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' letzte belegte Zeile (Spalte A)

For i = 1 To colTFiles.Count
strTXT = FSO.OpenTextFile(colTFiles.Item(i)).ReadAll
objWks.Cells(z, 2) = colPFiles.Item(i) ' Dateiname in Spalte B
While InStr(1, strTXT, strSW, vbTextCompare) > 0 ' m² ist drin
strTXT = Mid(strTXT, InStr(1, strTXT, strSW) - intSWLen)
objWks.Cells(z, 1) = Left(strTXT, intSWLen) ' Wert eintragen
strTXT = Mid(strTXT, InStr(1, strTXT, strSW) + 2)
z = z + 1
Wend
Kill colTFiles.Item(i) ' txt-Files löschen
Next

End Sub


Das Problem: es wird gar nichts mehr in die Tabelle eingetragen. Mach ich etwas falsch?

Die Anwendung pdftotext ist in einem Subordner "Tools" gespeichert. Es kommt keine Fehlermeldung.
Danke für deine Geduld, wenn das dann klappt, ersparst du mir viele viele mühsame Arbeitstage händisches Eintippen.

Liebe Grüße,
Peter Sim
Member: Abfelpaum
Abfelpaum Nov 23, 2015 at 11:49:50 (UTC)
Goto Top
doch, eingetragen wird der Pfad und Name der pdf Datei in die Zelle B1.
Member: mak-xxl
mak-xxl Nov 23, 2015 at 12:46:19 (UTC)
Goto Top
Hallo Peter,

bitte benutze zum Posten (auch nachträglich) von Code die Code-Tags, sonst ist die Lesbarkeit schlecht.

Ich hatte den Hinweis gegeben, zunächst einmal festzustellen, ob im pdf-Text überhaupt der String 'm²' in dieser Schreibweise auftaucht. Das solltest Du prüfen und im Quelltext entsprechend eintragen.

Der Dateiname wird übrigens immer eingetragen, auch wenn kein Treffer vorliegt - will man das ändern, muss der Code
objWks.Cells(z, 2) = colPFiles.Item(i)          ' Dateiname in Spalte B  
an den Anfang des <while>-Constructs eingetragen werden, dann erscheint der Dateiname nur, wenn auch Treffer vorliegen - allerdings für jeden Treffer, also u.U. mehrfach.

Freundliche Grüße von der Insel - Mario
Member: Abfelpaum
Abfelpaum Nov 23, 2015 at 13:17:03 (UTC)
Goto Top
ah, so geht das. danke.
ich habe die pdf-datei im editor geöffnet und nach "m²" gesucht. ja, den text gibt es.
hier nun den code besser lesbar:


Sub PDF2Excel()

Dim i As Integer, z As Long
Dim strCMDLine As String, strTXT As String
Dim FSO As Object, objSFold As Object, objWks As Object, WSHShell As Object, tmp As Object
Dim colPFiles As New Collection, colTFiles As New Collection

Set WSHShell = CreateObject("WScript.Shell")  
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set objSFold = FSO.GetFolder(ThisWorkbook.Path)
Set objWks = ThisWorkbook.Sheets(1) ' Ausgabe  

strCMDLine = ThisWorkbook.Path & "\Tools\pdftotext.exe -raw -layout -nopgbrk "  

Const strSW As String * 2 = "m²" ' der Suchbegriff  
Const strSWlen = 9 ' der Wert [für 9.999,00 m²]  

For Each tmp In objSFold.Files ' alle Dateien einlesen  
If Right(tmp.Path, 4) = ".pdf" Then colPFiles.Add tmp.Path ' nur *.pdf  
Next tmp

For i = 1 To colPFiles.Count
WSHShell.Run (strCMDLine & Chr(34) & colPFiles.Item(i) & Chr(34)), 0, True
'Kill colPFiles.Item(i) ' pdf-Files löschen  
Next

For Each tmp In objSFold.Files ' wieder alles einlesen  
If Right(tmp.Path, 4) = ".txt" Then colTFiles.Add tmp.Path ' nur *.txt  
Next tmp

z = objWks.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' letzte belegte Zeile (Spalte A)  

For i = 1 To colTFiles.Count
strTXT = FSO.OpenTextFile(colTFiles.Item(i)).ReadAll
objWks.Cells(z, 2) = colPFiles.Item(i) ' Dateiname in Spalte B  
While InStr(1, strTXT, strSW, vbTextCompare) > 0 ' m² ist drin  
strTXT = Mid(strTXT, InStr(1, strTXT, strSW) - intSWLen)
objWks.Cells(z, 1) = Left(strTXT, intSWLen) ' Wert eintragen  
strTXT = Mid(strTXT, InStr(1, strTXT, strSW) + 2)
z = z + 1
Wend
Kill colTFiles.Item(i) ' txt-Files löschen  
Next

End Sub
Member: mak-xxl
mak-xxl Nov 23, 2015 at 13:32:32 (UTC)
Goto Top
Hallo Peter,

sicherheitshalber musst Du, falls nichts gefunden wird, den Rückgabestring von pdf2text prüfen, ob das auch als 'm²' auftaucht.
Das geht mit einem
MsgBox strTXT
nach Zeile 34 in Deinem Code.
Notfalls den String an einer bekannt markanten Stelle kürzen, wenn nicht alles in die Box passt, oder in eine Zelle ausgeben lassen oder in eine Textdatei ...

Freundliche Grüße von der Insel - Mario
Member: Abfelpaum
Abfelpaum Nov 23, 2015 at 13:52:15 (UTC)
Goto Top
Hallo Mario,

in der Massagebox wird der Text von Anfang an ausgegeben - also vom beginn des pdfs. Die Suche nach "m²" funktioniert also nicht.
Es wird auch ein txt file erstellt, in dem der komplette text des pdfs steht.

Beste Grüße,
Peter Sim
Member: mak-xxl
mak-xxl Nov 23, 2015 at 14:03:59 (UTC)
Goto Top
Hallo Peter,

so soll es auch sein - die komplette pdf-Datei als Text(-datei bzw. String). Jetzt musst Du schauen, in welcher Form der String 'm²' (in der pdf-Datei so angezeigt) in der Textdatei resp. im String landet. Diese Form (i.e. 'm2' oder 'm-2') muss als Suchstring in Zeile 15 Deines Codes eingetragen werden.

Freundliche Grüße von der Insel - Mario
Member: Abfelpaum
Abfelpaum Nov 23, 2015 at 14:13:03 (UTC)
Goto Top
Hallo,

auch das passt. Im String, zum Beispiel: "39,09 m²" und in Zeile 15 suche ich nach "m²".

LG,
Peter
Member: Abfelpaum
Abfelpaum Nov 23, 2015 at 14:14:36 (UTC)
Goto Top
Gibt es vielleicht eine praktische Möglichkeit, dir eines der pdfs zukommen zu lassen?
Member: mak-xxl
mak-xxl Nov 23, 2015 at 14:40:00 (UTC)
Goto Top
Hallo Peter,

aber klar - per PM (User anklicken -> Mehr -> Nachricht schreiben).

Hiermit kannst Du die Mailadresse erbitten und, falls es um sensible Daten geht, bitte nur verschlüsselt oder neutralisiert kommunizieren.

Freundliche Grüße von der Insel - Mario
Member: Abfelpaum
Abfelpaum Nov 25, 2015 at 12:59:20 (UTC)
Goto Top
Hallo Mario,

ich hab die den Zugang zum pdf per PM geschickt.

LG,
Peter
Member: mak-xxl
mak-xxl Nov 25, 2015, updated at Nov 26, 2015 at 14:02:28 (UTC)
Goto Top
Hallo Peter,

vielen Dank für die Datei.

Der modifizierte Code berücksichtigt einige Besonderheiten der pdf-Vorlage:

- die maximale Fläche sollte wohl 999,99 m² nicht übersteigen,
- sie liegt meist unter 100,00 m²,
- die Angaben erfolgen mit und ohne Komma - die Stellenzahl schwankt also,
- andere Angaben im Zusammenhang mit 'm²' (i.e. kWh/m²) kommen vor.

Die Variable 'intSWlen' wurde deshalb auf 6 reduziert - also max. 999,99 m², passend dazu wurde das Leerzeichen vor dem 'm²' zum Suchbegriff hinzugenommen. Damit wird verhindert, dass z.B. der häufig vorkommende String 'kWh/m²' überhaupt erfasst wird.
Zu Beginn des while-Constructs werden wie gehabt 7 Zeichen vor dem 'm²' stehen gelassen.
Danach wird (in Zeile 41) geprüft, ob am Beginn (den ersten 9 Zeichen) des Gesamtstrings mehr als 1 Leerzeichen enthalten ist (das vor dem 'm²'), wenn ja, wird der String zeichenweise (von links) gekürzt. Das löst auch Angaben wie 'ca. xx m²' sauber auf.

Die Ausgabe des Textstrings in Spalte B dient nur der Kontrolle, ob etwa die Val()-Funktion durch einen Punkt (statt eines Kommas) genarrt wurde.

Sub PDF2Excel()

    Dim i As Integer, j As Integer, z As Long
    Dim strCMDLine As String, strTXT As String
    Dim FSO As Object, objSFold As Object, objWks As Object, WSHShell As Object, tmp As Object
    Dim colPFiles As New Collection, colTFiles As New Collection

    Set WSHShell = CreateObject("WScript.Shell")  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    Set objSFold = FSO.GetFolder(ThisWorkbook.Path)
    Set objWks = ThisWorkbook.Sheets(1)                                 ' Ausgabe  

    strCMDLine = ThisWorkbook.Path & "\Tools\pdftotext.exe -raw -layout -nopgbrk "  

    Const strSW As String * 3 = " m²"                                   ' der Suchbegriff  
    Const intSWlen = 7                                                  ' der Wert [für 999,00 m²]  

    For Each tmp In objSFold.Files                                      ' alle Dateien einlesen  
        If Right(tmp.Path, 4) = ".pdf" Then colPFiles.Add tmp.Path      ' nur *.pdf  
    Next tmp

    For i = 1 To colPFiles.Count
        WSHShell.Run (strCMDLine & colPFiles.Item(i)), 0, True
'        Kill colPFiles.Item(i)                                          ' pdf-Files löschen  
    Next

    For Each tmp In objSFold.Files                                      ' wieder alles einlesen  
        If Right(tmp.Path, 4) = ".txt" Then colTFiles.Add tmp.Path      ' nur *.txt  
    Next tmp

    objWks.Range("A:B").ClearContents                                   ' Spalte A und B löschen  

    z = objWks.Cells(Rows.Count, 1).End(xlUp).Row + 1                   ' letzte belegte Zeile (Spalte A)  

    For i = 1 To colTFiles.Count
        strTXT = FSO.OpenTextFile(colTFiles.Item(i)).ReadAll
'        objWks.Cells(z, 4) = colPFiles.Item(i)                         ' Dateiname in Spalte D  
        While InStr(1, strTXT, strSW, vbTextCompare) > 0                ' m² ist drin  
            strTXT = Mid(strTXT, InStr(1, strTXT, strSW) - intSWlen)    ' zunächst Maximum herauslösen  
            For j = intSWlen - 1 To 3 Step -1                           ' Stellenanzahl für m² dekr.  
                If UBound(Split(Mid(strTXT, 1, j + 1), " ")) > 0 Then   ' mehr als 1 Leerzeichen im String  
                    strTXT = Mid(strTXT, 2, Len(strTXT) - 1)            ' Gesamtstring links 1 Zeichen kürzen  
                End If
            Next j
            objWks.Cells(z, 1) = Val(Replace(Left(strTXT, intSWlen), ",", ".")) ' Wert eintragen (als Zahl)  
            objWks.Cells(z, 2) = Replace(Left(strTXT, intSWlen), vbCrLf, "")    ' Textstring (zur Kontrolle)  
            strTXT = Mid(strTXT, InStr(1, strTXT, strSW) + 2)
            z = z + 1
        Wend
'        Kill colTFiles.Item(i)                                         ' txt-Files löschen  
    Next

End Sub

PS:
In meinem Post vom 23.11.2015 um 11:08 Uhr habe ich für Zeile 16 die Variable 'strSWlen' mit 8 belegt und dann für Zeile 37+38 deren Verwendung als 'intSWlen' vorgeschlagen - das war Murks: Sie muss natürlich in beiden Fällen 'intSWlen' heißen. Ich bitte das zu entschuldigen. Aufgefallen ist das aus 2 Gründen nicht:
- ich habe das Konstrukt nur geschrieben, nicht getestet.
- Du hast es getestet, aber auf Deinem Modulblatt fehlte das wichtigste Statement überhaupt: 'Option Explicit'.
Am Blattanfang eines Moduls etc. notiert, warnt es sofort bei nicht deklarierten Variablen (hätte also im vorliegenden Fall die Zeilen 37+38 moniert).

Freundliche Grüße von der Insel - Mario
Member: Abfelpaum
Abfelpaum Nov 30, 2015 at 15:46:01 (UTC)
Goto Top
Lieber Mario!
Das klappt wunderbar! Ich dank dir vielmals!
Wenn immer dich es nach Wien verschlägt, bist auf ein Bier eingeladen!
Liebe Grüße,
Peter
Member: herr-jfs
herr-jfs Nov 23, 2020 at 17:13:27 (UTC)
Goto Top
Moin,

ich kommentiere diesen Thema auf die Gefahr hin, mich für das Ausgraben eines alten Threads sehr unbeliebt zu machen.

Ich habe (fast) dieselbe Aufgabenstellung wie der Ursprungsersteller und dafür dieses Skript (Pdf auslesen und in excel schreiben, untere Variante) verwendet.
Leider kommt in meinen PDF-Dateien der Suchbegriff (Rechnung) mehrfach vor, sodass die Ausgabe nur sehr unvollständig erscheint.

Wie kann ich das Skript dazu bringen, nach dem ersten erfolgreichen Finden des Begriffs in die nächste Datei zu springen?

Vielen Dank im Voraus.
Member: mak-xxl
mak-xxl Nov 23, 2020 at 18:52:21 (UTC)
Goto Top
Moin, herr-jfs;

wenn Du mit dem jeweils ersten Treffer einer Datei zufrieden bist, dann füge im von Dir referenzierten Quelltext (im Post vom 25.11.2015) eine Zeile n a c h Zeile 48 ein. In diese Zeile kommt dann ein beherztes 'Exit While'.

Viel Erfolg und freundliche Grüße von der Insel - Mario
Member: FMgoe3
FMgoe3 Nov 30, 2020 updated at 19:53:38 (UTC)
Goto Top
Hallo zusammen,

da der Thread erst vor ein paar Tagen wiederbelebt wurde möchte ich meine Frage gleich hier stellen:
Vorab: vielen Dank für die Bereitstellung und Dokumentation, dies hat mir bereits sehr weitergeholfen.

Leider habe ich es bisher nicht geschafft dies auf meine Bedürfnisse anzupassen; zum einen habe ich das Problem, dass die erstellte .txt Datei einen Zeilenumbruch hat, demnach ist es nicht

Suchbegriff: "Inhalt" sondern
Suchbegriff:
"Inhalt"


Als nächstes wollte ich versuchen die nachfolgenden Zeichen bis zum benötigten "Inhalt" aus dem string zu entfernen, vielleicht gibt es aber auch eine schönere Lösung.

Weiterhin möchte ich aus den vorhandenen pdfs (bzw. txts) die Adresse in die Excel-Liste übertragen; in diesem Fall handelt es sich um 3 (bzw. 4) Umbrüche:

Name
Straße
PLZ, Ort

in Ausnahmefällen, sollte die Person im Ausland leben
Land

Über eine Rückmeldung würde ich mich freuen.

Viele Grüße
Member: mak-xxl
mak-xxl Dec 01, 2020 at 07:46:26 (UTC)
Goto Top
Moin FMgoe3,

herzlich willkommen im Forum!

Am schnellsten geht es, wenn Du die pdf-Datei nebst kurzer Erläuterung per PN schickst. Enthält diese Kundendaten, dann nur verschlüsselt. In meiner Antwortmail stehen dann Kontaktdaten für das Passwort.
Sollte das Problem lösbar sein, können wir anschließend darüber befinden, welche Details die hier gepostete Lösung haben darf.

Freundliche Grüße von der Insel - Mario
Member: merlin1.1
merlin1.1 Dec 01, 2021 at 12:59:50 (UTC)
Goto Top
Hallo,

kurze Frage: ist es auch möglich, einen Textmarker zu nutzen, der über mehrere Zeilen geht, inkl. Zeilenumbrüche?
Ich bräuchte Inhalte von 3 Zeilen, wo kein Fester Text vorangeführt ist.

Falls nicht verständlich:

In Zeile 3 steht z.B. immer "ab hier", in Zeile 6 steht immer "bis hier". Kann ich alles, was dazwischen liegt, in Excel schreiben?

Danke, Grüße
der Merlin.
Member: mak-xxl
mak-xxl Dec 01, 2021 at 21:35:59 (UTC)
Goto Top
Moin, Merlin,

ohne jetzt die relativ alte Lösung aus dem Archiv zu kramen: Prinzipiell können mehrere Zeilen (= ein Bereich) durch eine RegEx markiert und ausgelöst werden. Entscheidend dabei ist, was dabei alles als 'Müll' extrahiert und evtl. aufwendig behandelt werden muss.
Was man probieren sollte: Wenn die Daten als Tabelle (in der pdf) vorliegen, mit einer aktuellen Excel-Version diese importieren. (Register „Daten“ wählen, dann „Daten abrufen –› Aus Datei –› Aus PDF').
Wenn noch Hilfe notwendig ist, bitte melden.

Freundliche Grüße von der Insel - Mario
Member: merlin1.1
merlin1.1 Dec 03, 2021 at 13:43:24 (UTC)
Goto Top
Hallo Mario, danke für den Hinweis.

Ich habe mir mal so ein modernes "M365" besorgt und getestet. Weißt du, wie ich damit eine Stapel-Verarbeitung hinbekomme? Also einige PDFs automatisiert einlesen.

Danke
Member: mak-xxl
mak-xxl Dec 03, 2021 at 14:27:32 (UTC)
Goto Top
Moin, Merlin,

wenn Du alle Schritte, die zum Einlesen einer pdf-Datei (Klicks, Eingaben etc.) notwendig sind, flüssig beherrscht, dann startest Du unter 'Entwickler-Tools' den Punkt 'Makro aufzeichnen' und führst genau diese Schritte einmal durch. Dann 'Aufzeichnung beenden' und das Ergebnis mit Alt+F10 ansehen. Das Konstrukt in eine Schleife packen, Dateinamen in ein Array etc. pp. Solltest Du mit VBA nix am Hut haben, können wir gern zusammen eine Lösung finden.

Freundliche Grüße von der Insel - Mario