PDF Seiten zählen
17.05.2019 08:48:19
Jakob
Ich habe um die 100 PDF Dateien, von denen ich gern die Seitenzahlen eines bestimmten Kapitels zählen würde.
Im Archiv hab ich diesen Code gefunden https://www.herber.de/forum/archiv/1556to1560/1557305_PDF_Seitenanzahl_feststellen.html, da muss ich allerdings erst recht wieder jedesmal ein pdf auswählen.
Nun hab ich in meiner Excel Datei die Idee, in Spalte A die Dateinamen zu haben (schaffe ich mit VBA), und dann in Spalte B die dazugehörige Seitenzahl (schaffe ich nicht mit VBA) (idealerweise nur von Kapitel 2, aber auch die Gesamtseitenzahl des Dokuments würd mir schon helfen.
Jemand mit besseren VBA-Kenntnissen als ich eine Idee, wie das umzusetzen ist?
Hochgeladene Datei: https://www.herber.de/bbs/user/129835.xlsm
Im Voraus vielen Dank!
Jakob
Option Explicit
Public Sub PDFCounter()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
With .Filters
If .Count > 0 Then .Delete
Call .Add(Description:="PDF-Dateien", Extensions:="*.pdf")
End With
If .Show Then
Cells(2, 2).Value = GetPageCount(.SelectedItems(1))
End If
End With
End Sub
Private Function GetPageCount(ByVal pvstrFileName As String) As Long
Dim strText As String
Dim strLinearized As String, astrCount() As String
Dim ialngIndex As Long
Dim objFileSystemObject As Object, objTextFile As Object
Dim objRegEx As Object, objMatch As Object, objItem As Object
Dim blnFound As Boolean
GetPageCount = -1
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFileSystemObject.OpenTextFile(pvstrFileName, 1, False, 0)
Do Until objTextFile.AtEndOfStream
strText = objTextFile.ReadLine
strText = Replace(strText, vbLf, vbNullString)
If CBool(InStr(1, strText, "/Linearized")) Then
If Len(strText) > 20 Then
strLinearized = strText
blnFound = True
Exit Do
End If
End If
If CBool(InStr(1, strText, "/Count ")) Then
ReDim Preserve astrCount(ialngIndex)
astrCount(ialngIndex) = strText
ialngIndex = ialngIndex + 1
blnFound = True
End If
Loop
Call objTextFile.Close
Set objTextFile = Nothing
Set objFileSystemObject = Nothing
If blnFound Then
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
If strLinearized vbNullString Then
.Pattern = "\/N.?(\d+).?"
Set objMatch = .Execute(strLinearized)
If objMatch.Count > 0 Then _
GetPageCount = CLng(objMatch(0).SubMatches(0))
Else
If ialngIndex = 1 Then
.Pattern = "\/Count.?(\d+)"
Set objMatch = .Execute(astrCount(0))
If objMatch.Count = 1 Then
GetPageCount = CLng(objMatch(0).SubMatches(0))
Else
For Each objItem In objMatch
GetPageCount = WorksheetFunction.Max( _
GetPageCount, CLng(objItem.SubMatches(0)))
Next
End If
Else
.Pattern = "\/Count.?(-?\d+)"
For ialngIndex = 0 To UBound(astrCount)
Set objMatch = .Execute(astrCount(ialngIndex))
GetPageCount = WorksheetFunction.Max( _
GetPageCount, CLng(objMatch(0).SubMatches(0)))
Next
End If
End If
End With
Set objMatch = Nothing
Set objRegEx = Nothing
End If
End Function