Seitenzahl mehrerer PDF-Dokumente ermitteln?

Hallo,

ich hätte da eine Lösung für Excel:

Option Explicit
Public Sub PDF_Info()
Const FOLDER_PATH = "D:\Eigene Dateien\Eigene eBooks\" 'Ordner in dem sich die PDF's befinden
Dim strFileName As String
Dim lngRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayStatusBar = True
End With
lngRow = 1
With Tabelle1
With .Cells(lngRow, 1).Resize(1, 2)
.EntireColumn.Clear
.Value = Array("Dokument", "Seiten")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
strFileName = Dir$(FOLDER_PATH & "*.pdf")
Do Until strFileName = vbNullString
Application.StatusBar = strFileName
lngRow = lngRow + 1
.Cells(lngRow, 1).Resize(1, 2).Value = Array(strFileName, _
GetPageCount(FOLDER_PATH & strFileName))
strFileName = Dir$
Loop
.Columns(1).AutoFit
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
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