·
2 months ago
Good day, I had the problem that for some versions of PDF with Word, this code gave me sometimes a multiple (like 4x) of the actual page numbers. My solution was to search a string in the PDF file that actually states the page numbers and if it can be of help for anyone, this is the sub I used:
Function GetPDFpag(File1 As String) As Long
Const ForReading = 1, ForWriting = 2
Dim FSO As Object
Dim FileIn, FileOut, strTmp, strOut, Scheck As String
Dim Nstart, Nstop As Long
Dim K As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileIn = FSO.OpenTextFile(File1, ForReading, False, 0)
'we search for the first line with string "/Kids[" in which the number of pages is
Scheck = "no"
K = 1
Do Until FileIn.AtEndOfStream Or Scheck = "yes"
K = K + 1
strTmp = FileIn.readline
If Len(strTmp) > 0 Then
If InStr(1, strTmp, "/Count", vbTextCompare) > 0 And InStr(1, strTmp, "/Kids[", vbTextCompare) > 0 Then
strOut = strTmp
Scheck = "yes"
End If
End If
Loop
If Scheck = "no" Then
strOut = 0
Else
Nstart = InStr(strOut, "/Count") + 7
Nstop = InStr(strOut, "/Kids")
Nstop = Nstop - Nstart
strOut = Mid(strOut, Nstart, Nstop)
End If
FileIn.Close
'FileOut.Close
GetPDFpag = Val(strOut)
Set FSO = Nothing
End Function
Const ForReading = 1, ForWriting = 2
Dim FSO As Object
Dim FileIn, FileOut, strTmp, strOut, Scheck As String
Dim Nstart, Nstop As Long
Dim K As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileIn = FSO.OpenTextFile(File1, ForReading, False, 0)
'we search for the first line with string "/Kids[" in which the number of pages is
Scheck = "no"
K = 1
Do Until FileIn.AtEndOfStream Or Scheck = "yes"
K = K + 1
strTmp = FileIn.readline
If Len(strTmp) > 0 Then
If InStr(1, strTmp, "/Count", vbTextCompare) > 0 And InStr(1, strTmp, "/Kids[", vbTextCompare) > 0 Then
strOut = strTmp
Scheck = "yes"
End If
End If
Loop
If Scheck = "no" Then
strOut = 0
Else
Nstart = InStr(strOut, "/Count") + 7
Nstop = InStr(strOut, "/Kids")
Nstop = Nstop - Nstart
strOut = Mid(strOut, Nstart, Nstop)
End If
FileIn.Close
'FileOut.Close
GetPDFpag = Val(strOut)
Set FSO = Nothing
End Function