PDF Seiten zählen

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