Extraer el número de páginas de un documento

Después de realizar múltiples pruebas aleatorias con distintos tamaños de archivos PDF, parece que este código podría funcionar….

La siguiente función es una combinación de fragmentos de código de diferentes autores, ya que ninguno de ellos funcionaba correctamente, especialmente para archivos de gran tamaño.

Pruébalo … a ver que tal ….Sin embargo, es importante tener en cuenta que no ha sido testado completamente y es posible que existan errores (bugs).

Function funContarPaginasPDF(PonFichero As String) As Integer
      On Error GoTo Err_Local
      Rem www.accessdemo.info

      Dim objRegExp As Object
      Dim strInput As String
      Dim strNumPages As String
      Dim strRetVal As String
      Dim intFileNum As Integer
      Dim intPosN1 As Integer
      Dim intPosN2 As Integer
      Dim intPosCount1 As Integer
      Dim intPosCount2 As Integer


      If LCase(Right(PonFichero, 3)) <> "pdf" Then
            funContarPaginasPDF = 0
            Exit Function
      End If

      intFileNum = FreeFile
      Open PonFichero For Binary Lock Read Write As #intFileNum


      Set objRegExp = CreateObject("VBscript.RegExp")
      objRegExp.Global = True
      objRegExp.Pattern = "/Type\s*/Page[^s]"

      If strNumPages = "" Then

            Do Until EOF(intFileNum)
                  Input #1, strInput
                  strInput = UCase(strInput)
                  intPosN1 = InStr(1, strInput, "/N ") + 3
                  intPosN2 = InStr(intPosN1, strInput, "/")
                  intPosCount1 = InStr(1, strInput, "/COUNT ") + 7
                  intPosCount2 = InStr(intPosCount1, strInput, "/")

                  If intPosN1 > 3 Then
                        strNumPages = Mid(strInput, intPosN1, intPosN2 - intPosN1)
                        Exit Do
                  End If

                  If intPosCount1 > 7 Then
                        strNumPages = Mid(strInput, intPosCount1, intPosCount2 - intPosCount1)
                        Exit Do
                  End If

            Loop

      End If


Close_Local:
      Set objRegExp = Nothing
      Close #intFileNum
      funContarPaginasPDF = CInt(strNumPages)

Exit_Local:
      On Error GoTo 0
      Exit Function

Err_Local:
      MsgBox Err.Description, vbCritical, "Error N°:  " & Err.Number
      Resume Exit_Local
End Function