phade
Goto Top

Eine Frage zu VBA per Excel 2010 zur Seitenauslese von PDF-dateien

Moin Moin,

ich habe eine Frage bzw. ein Problem mit einem VBA-Script zum auslesen der Seitenanzahl von PDF-Dateien.
Die Dateien liegen alle in einem Verzeichnis. Ich habe folgendes Script welches mich aber bei der Ausführung nach einer Datei fragt, was aber umständlich ist, denn eig kann/soll es einfach durch das Verzeichnis der Dateien drüberlaufen und die Seitenanzahl ausgeben. Und wenn ich einen Dateiname eingebe, kommt der Fehler "53" - Datei nicht gefunden, aber die Datei ist definitif da und auch i.O.

Hier mal der AKTUELLE Quellcode:
Sub PDFCounter()

Dim buf As String, fil As String, i As Integer
Dim fso, pdf, pos As Integer, p2 As Integer

a = FreeFile

Filename = InputBox("Bitte Dateinamen (ohne Erweiterung) eingeben:", "Öffnen...")  

If Filename = "" Then Exit Sub  

FilePath = "D:\Rechnungen\" & Filename & ".pdf"  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set pdf = fso.OpenTextFile(FilePath)

Do While Not pdf.AtEndOfStream
buf = pdf.ReadLine
pos = InStr(1, buf, "/Count")  

If pos > 0 Then
    buf = Mid(buf, pos + 7)
    p2 = InStr(1, buf, Chr(13))
    
    If p2 <> 0 Then
        buf = Left(buf, p2 - 1)
    End If
    
    i = CLng(buf)

    Exit Do
End If

Loop
Range("a3") = i  

End Sub
Kann mir jemand einen Tipp geben, wo ich gerade falsch denke?

Thx vorab.

Content-Key: 155819

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

Ausgedruckt am: 29.03.2024 um 04:03 Uhr

Mitglied: 76109
76109 26.11.2010 um 11:05:00 Uhr
Goto Top
Hallo Phade!

InputBox(Anzeigetext, Titel, Default)
z.B.
InputBox("Bitte ...", "Öffnen...", "D:\Rechnungen\"

Versuchs mal so:
FileName = InputBox("Bitte Dateinamen (ohne Erweiterung) eingeben:", "Öffnen...")   

If FileName = "" Then Exit Sub  

FilePath = "D:\Rechnungen\" & FileName & ".pdf"   

Set fso = CreateObject("Scripting.FileSystemObject")  
Set pdf = fso.OpenTextFile(FilePath)

Gruß Dieter
Mitglied: Phade
Phade 26.11.2010 um 11:18:38 Uhr
Goto Top
Hallo Didi1954,

das funktioniert supi, danke!

Gibt es vllt noch die Möglichkeit, dass ich hingehen kann und das ich nicht mehr den Dateinamen eingeben muss?
Es sind mehrere hunder Dateien die damit überprüft werden sollen...

Danke schon mal!!
Mitglied: Biber
Biber 26.11.2010 um 11:26:08 Uhr
Goto Top
Moin Phade,

wäre es dann nicht sinnvoll, wenn du die Pfadangabe und die Namenskonvention deiner Einsaug-Tabellen mal offenlegst oder soll didi1954 sich Dummy-Restriktionen ausdenken?

P.S. Magst du deinen Beitrag mal mit Code-Formatierung nachbehandeln bitte?

Grüße
Biber
Mitglied: Phade
Phade 26.11.2010 um 11:43:01 Uhr
Goto Top
Zitat von @Biber:
Moin Phade,

wäre es dann nicht sinnvoll, wenn du die Pfadangabe und die Namenskonvention deiner Einsaug-Tabellen mal offenlegst oder soll
didi1954 sich Dummy-Restriktionen ausdenken?


Moin Biber,

Beitrag is editiert ;)

Ähm, hilf mir nochmal kurz, was braucht ihr noch?
Wenn du mit Einsaug-tabelle die Excel-Datei meinst, in der das vba "läuft", die liegt zur Zeit auf meinem Desktop und die Test PDFs liegen auf meiner D:-Partition.
Die PDFs sind Rechnung von meiner Firma, und ich möchte aus denen halt die Gesamtseitenzahl aller PDFs ermitteln.
Ähm, die Namenskonvention der PDF sieht so aus -- 999-38142-86555453-E.pdf
Hier ist zu beachten, das die ersten 8 Ziffern gleich bleiben und sich nur die letzten 8 und der Buchstabe sich ändert.
Habe jetzt noch erfahren, das nur die Dateien, die mir *-*-*-E.pdf enden relevant sind. Also wenn ich zum Beispiel jetzt vorgeben kann:" ...lese nur die Dateien *-E.pdf aus und schreibe zeilenzahl in Excelzelle..." dann wäre ich ja schon durch....aber ich stehe gerade vorm Berg-

Hoffe das war das gesuchte ;)

Thx
Mitglied: bastla
bastla 26.11.2010 um 22:23:48 Uhr
Goto Top
Hallo Phade!

Sollte sich dann etwa so machen lassen:
Option Explicit
Sub PDFCounter()

Dim buf As String, fil As String, i As Integer
Dim FilePath As String, FileMask As String, FileExt As String
Dim Column As Integer, Row As Long
Dim fso, File, pdf, FileName As String, pos As Integer, p2 As Integer

FilePath = "D:\Rechnungen\"  
FileMask = "*-E" 'genau hinsichtlich Groß-/Kleinschreibung  
FileExt = "pdf" 'in Kleinbuchstaben  

Column = 1 'Einträge in Spalte "A" ...  
Row = 3 '... ab Zeile 3  

Set fso = CreateObject("Scripting.FileSystemObject")  

For Each File In fso.GetFolder(FilePath).Files 'alle Dateien des vorgegebenen Ordners durchgehen ...  
    FileName = File.Name
    '.... und nur passende verarbeiten  
    If fso.GetBaseName(FileName) Like FileMask And LCase(fso.GetExtensionName(FileName)) = FileExt Then
        Set pdf = fso.OpenTextFile(File.Path)

        Do While Not pdf.AtEndOfStream
            buf = pdf.ReadLine
            pos = InStr(1, buf, "/Count")  

            If pos > 0 Then
                buf = Mid(buf, pos + 7)
                p2 = InStr(1, buf, Chr(13))
    
                If p2 <> 0 Then buf = Left(buf, p2 - 1)
    
                i = CLng(buf)

                Exit Do
            End If
        Loop
            
        Cells(Row, Column) = i 'Seitenzahl eintragen  
        Cells(Row, Column + 1) = FileName 'Dateinamen eintragen  
        Row = Row + 1 'Zeilennummer erhöhen  
    End If
Next
End Sub
Noch eine Anmerkung zur Variablendeklaration mit "Dim": So richtig sinnvoll wird diese erst in Kombination mit "Option Explicit", da dann keine nicht deklarierten (weil zB falsch geschriebenen) Variablen akzeptiert werden - daher entweder alle Variablen deklarieren oder (fast) keine ...

... und: die ermittelte Seitenanzahl hätte sich vielleicht auch einen etwas "sprechenderen" Namen (als "i") verdient.

Zur Kontrolle würde es vermutlich (zumindest während der Testphase) auch nicht schaden, zusätzlich den Dateinamen in die Tabelle einzutragen - dann würde ich in Zeile 13 die Spalte durch Angabe der Nummer (1) anstelle des Buchstabens festlegen und als Zeile 40a
Cells(Row, Column + 1) = File.Name 'Dateinamen eintragen
verwenden (die Deklaration von "Column" als "String" ist dann auch nicht mehr korrekt).
Eine Vereinfachung hinsichtlich der Prüfung des Dateinamens ergäbe sich noch, wenn entweder sichergestellt ist, dass sowohl Dateimaske als auch Dateityp hinsichtlich Groß-/Kleinschreibung exakt sind (also zB "pdf" immer in Kleinbuchstaben vorliegt) oder mit "Option Compare Text" vorweg die Berücksichtigung von Groß-/Kleinschreibung ausgeschaltet wird - dann könnten
FileMask = "*-E" 'genau hinsichtlich Groß-/Kleinschreibung  
FileExt = "pdf" 'in Kleinbuchstaben  
zu
FileMask = "*-E.pdf" 'genau hinsichtlich Groß-/Kleinschreibung  
zusammengefasst und die Zeile 21 auf
If FileName Like FileMask Then
verkürzt werden.

Grüße
bastla
Mitglied: 76109
76109 27.11.2010 um 14:02:21 Uhr
Goto Top
Hallo Phade!

Wobei in bastlas Code, die Codezeilen 24 - 38 noch durch folgende Codezeilen ersetzt werden könnten:
        'Dim Text as Variant, i As Long  
         
         Do Until Pdf.AtEndOfStream
             Text = Split(WorksheetFunction.Clean(Pdf.ReadLine), "/Count ")  
             If UBound(Text) = 1 Then  i = CLng(Split(Text(1))(0)):  Exit Do 
          Loop

Gruß Dieter

[edit] auf bastlas Anregung geändert und funktioniert mit anderen Test-Pdf's doch nicht. Siehe weiter unten [/edit]
Mitglied: bastla
bastla 27.11.2010 um 14:06:19 Uhr
Goto Top
@Dieter
Wobei in bastlas Code, die Codezeilen 24 - 38 ...
Ehre, wem Ehre gebührt face-wink: die Zeilen hatte Phade schon selbst mitgebracht ...

An eine Vereinfachung hatte ich auch schon gedacht, war allerdings noch nicht dazu gekommen; außerdem dürfte das ohne genaue Kenntnis der von Phade verwendeten PDF auch nicht ganz so einfach sein, da ich bei einem ersten Test mit dem neuen Code bereits eine nicht auswertbare Datei (Fehler: "Type mismatch" - was bei einem Wert von "2 >> endobjxref0 126 0000000000 65535 f" für Text(1), resultierend aus der Tatsache, dass die Zeile mit "CR" abgeschlossen war, auch nicht weiter verwundert) vorfand.

Mit
If UBound(Text) = 1 Then  i = CLng(Split(Text(1))(0)):  Exit Do
sollte es aber etwas sicherer sein ...

Grüße
bastla
Mitglied: 76109
76109 27.11.2010 um 15:11:23 Uhr
Goto Top
Hallo bastla!

Bei meinen Test's ist dieser Fehler leider nicht aufgetreten. Von daher danke für die Unterstützungface-wink

Meine Test-Pdf's enthielten auch nur LF's und keine CR's, was wohl auch sehr unterschiedlich ist und die PDF's als Text-Dateien zu bearbeiten ist auch schon eine Sache für sichface-wink

Die betreffenden Codezeilen in Deinem Code gegebenenfalls zu ändern, bezogs sich auch nur insofern auf Deinen Code, weil dieser im Prinzip ja schon ein Endprodukt darstellt. Und das Du den Code nur 1:1 übernommen hast, ist mir durchaus bewusstface-wink

Gruß Dieter
Mitglied: 76109
76109 27.11.2010 um 19:52:55 Uhr
Goto Top
Hallo bastla!

Habe noch ne andere Variante gefunden, d.h. mein obiger Codeschnippsel funktioniert doch nichtface-sad
Text(1) = "1/Type/Pages/Kids[13 0 R]>>"

Also doch auf Ziffern prüfenface-wink
            Do Until Pdf.AtEndOfStream
                Text = Split(WorksheetFunction.Clean(Pdf.ReadLine), "/Count ")  
                If UBound(Text) = 1 Then
                    i = 1
                    Do While IsNumeric(Mid(Text(1), i, 1)): i = i + 1:  Loop
                    i = CLng(Left(Text(1), i - 1)):  Exit Do
                End If
            Loop

Gruß Dieter
Mitglied: bastla
bastla 27.11.2010 um 20:46:00 Uhr
Goto Top
Hallo Dieter!

... oder gleich Nägel mit Köpfen machen face-wink:
Option Explicit
Option Compare Text

Sub PDFCounter()

Dim FilePath As String, FileMask As String, FileExt As String
Dim Column As Integer, Row As Long
Dim fso, rE, File, pdf, FileName As String
Dim Match, Pages As Long

FilePath = "D:\Rechnungen\"  
FileMask = "*-E" 'genau hinsichtlich Groß-/Kleinschreibung  
FileExt = "pdf" 'in Kleinbuchstaben  

Column = 1 'Einträge in Spalte "A" ...  
Row = 3 '... ab Zeile 3  

Set fso = CreateObject("Scripting.FileSystemObject")  

Set rE = CreateObject("VBScript.Regexp")  
rE.Pattern = "/Count (\d*)" 'Sucbegriff = "/Count <Ziffer(n)>"  

For Each File In fso.GetFolder(FilePath).Files 'alle Dateien des vorgegebenen Ordners durchgehen ...  
    FileName = File.Name
    '.... und nur passende verarbeiten  
    If fso.GetBaseName(FileName) Like FileMask And LCase(fso.GetExtensionName(FileName)) = FileExt Then
        Set pdf = fso.OpenTextFile(File.Path) 'Datei öffnen ...  
        Do Until pdf.AtEndOfStream '... und notfalls bis zum Dateiende durchgehen  
            For Each Match In rE.Execute(Pdf.ReadLine) 'Zeile einlesen, durchsuchen und, wenn gefunden ....  
                Pages = CLng(Match.SubMatches(0)) '... Seitenzahl (<Ziffer(n)>) auslesen  
                Cells(Row, Column) = Pages 'Seitenzahl eintragen  
                Cells(Row, Column + 1) = FileName 'Dateinamen eintragen  
                Row = Row + 1 'Zeilennummer für Tabelle erhöhen  
                Exit Do 'Datei muss nicht weiter ausgelesen werden  
            Next
        Loop
        pdf.Close 'der Ordnung halber: Datei schließen  
    End If
Next
End Sub
[Edit] Dieters Vorschläge (siehe unten) integriert [/Edit]

Grüße
bastla
Mitglied: 76109
76109 27.11.2010 um 23:40:24 Uhr
Goto Top
Hallo bastla!

Toll! Das ist natürlich die wesentlich bessere Variante, die auch bei meinen unterschiedlichen Pdf's einwandfrei funktioniertface-smile Und als Zugabe auch noch kommentiertface-wink

Gruß Dieter

PS.
Die Codezeile 26 könnte man aber noch entfernen und die Codezeile 27 gleich so schreiben:
For Each Match In rE.Execute(Pdf.ReadLine) 'Zeile durchsuchen und wenn gefunden ...  
und nach dem Loop eventuell noch ein
Pdf.Close
einfügen
Mitglied: bastla
bastla 28.11.2010 um 12:09:45 Uhr
Goto Top
Hallo Dieter!

ACK, wobei das "Close" (da ja aus der Datei nur gelesen wird) eigentlich nicht nötig (aber auf jedenfalls sauberer) sein sollte, und das Einsparen der Variablen "Text" auch keine spürbaren Verbesserungen bringen dürfte - ich bau's aber trotzdem mal so ein ...

Grüße
bastla
Mitglied: 76109
76109 28.11.2010 um 13:43:30 Uhr
Goto Top
Hallo bastla!

War ja nur ein Vorschlagface-wink

Aber eine kleine Sache wäre da noch und zwar:
Funktioniert die Gleichbehandlung der Klein/Großschreibung mit dem Like-Operator ("*-E.PDF" gleich "*-e.pdf") nur, wenn die Option "Option Compare Text" gesetzt wird. face-wink

Gruß Dieter

[OT]
Ich versuche mich gerade an der ClipBoard-Geschichte aus nem anderen Thread.

Dieser Code funktioniert z.B. in Excel aber in VBS ClipBoard.SetData nicht.
    Set Html = CreateObject("HtmlFile")  
    Set ClipBoard = Html.ParentWindow.ClipboardData

    ClipBoard.SetData "Text", "Text für die Zwischenablage"  
Und dieser Code funktioniert zwar in VBS, aber es kommt beim Zugriff mit ClipBoard.SetData immer erst eine Sicherheitsabfrage
    Set Html = CreateObject("InternetExplorer.Application")   
    Html.Navigate "about:blank"  
   
    Set ClipBoard = Html.Document.ParentWindow.ClipboardData

    ClipBoard.SetData "Text", "Text für die Zwischenablage"  

Hast Du ne Idee, wie ich die Sicherheitsabfrage unterbinden kann?
[/OT]
Mitglied: bastla
bastla 28.11.2010, aktualisiert am 18.10.2012 um 18:44:12 Uhr
Goto Top
Hallo Dieter!
Funktioniert die Gleichbehandlung der Klein/Großschreibung mit dem Like-Operator ("*-E.PDF" gleich "*-e.pdf") nur, wenn die Option "Option Compare Text" gesetzt wird.face-wink
Habe ich zumindest (in der Online-Hilfe) so gelesen und ist auch das Ergebnis meiner Tests ...
[OT]
Zum "Clipboard"-Thema: Die Sicherheitsabfrage lässt sich vermutlich eliminieren, indem die Sicherheitseinstellungen des IE weit genug nach unten geschraubt werden - aber sollten die das wirklich?

Der Workaround unter Verwendung der "clip.exe" (geeignet, solange nur in die Zwischenablage kopiert werden soll) ist da für mich das kleinere Übel ...
[/OT]

Grüße
bastla
Mitglied: 76109
76109 28.11.2010 um 15:28:36 Uhr
Goto Top
Hallo bastla!

Also bei mir ergibt z.B. dieser Vergleich ohne "Option Compare Text" False
    If "*-e.pdf" Like "*-E.pdf" Then x = 1  
und mit "Option Compare Text" True
    If "*-e.pdf" Like "*-E.pdf" Then x = 1  
Was auch in der VBA-Hilfe zum Like-Operator bestätigt wird.

Zitat:
Das Verhalten des Operators Like hängt von der Option Compare-Anweisung ab (Standard ist Compare Binary)

Option Compare Text führt zu Zeichenfolgenvergleichen, die die im Gebietsschema des Systems gewählte Sortierreihenfolge für Zeichen verwenden (wobei keine Unterschiede in der Groß- und Kleinschreibung berücksichtigt werden).

Gruß Dieter

[OT]
Klar ist die Variante per Clip wesentlich einfacher, aber aus reinem Ergeiz hätte ich auch gerne die andere Variante zum Laufen gebracht.
Was mich bei der Clip-Variante etwas verwundert, ist die Tatsache, dass diese funktioniert, obwohl auf meinem System keine Clip.Exe zu finden ist.
[/OT]
Mitglied: bastla
bastla 28.11.2010 um 15:50:16 Uhr
Goto Top
Hallo Dieter!

Da hatte ich nicht genau genug gelesen bzw missverstanden, was Du gemeint hattest - natürlich wird nur dann nicht zwischen Groß- und Kleinschreibung unterschieden, wenn (um mich selbst zu zitieren face-wink - siehe Kommentar 26.11.2010, 22:23:48 Uhr)
... mit "Option Compare Text" vorweg die Berücksichtigung von Groß-/Kleinschreibung ausgeschaltet wird ...
- insofern sollte ich das tatsächlich noch in der vorläufig endgültigen Version ergänzen (und mache es auch gleich) ...

Grüße
bastla
Mitglied: 76109
76109 28.11.2010 um 16:03:50 Uhr
Goto Top
Hallo bastla!

Zitat von @bastla:
Da hatte ich nicht genau genug gelesen bzw missverstanden, was Du gemeint hattest ....
- insofern sollte ich das tatsächlich noch in der vorläufig endgültigen Version ergänzen (und mache es auch gleich) ...
Da bin ich aber Froh, dass wir dieses Missverständnis nun doch noch klären konntenface-smile

Gruß Dieter
Mitglied: Phade
Phade 29.11.2010 um 10:43:36 Uhr
Goto Top
Moin,

ich falle auf die Knie und verneige mich ;)

Ich danke euch für eure hilfe, genau das hab ich gesucht!!!

hat alles geklappt. Und danke für die erklärenden Kommentare ;) sieht man ziemlich slten ;)

nochmal Danke.

Phade