Visual Basic - Ayuda con programa VBA para contar números de página de los archivos PDF en Excel

Life is soft - evento anual de software empresarial
 
Vista:
Imágen de perfil de Pedro
Val: 2
Ha disminuido su posición en 11 puestos en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Ayuda con programa VBA para contar números de página de los archivos PDF en Excel

Publicado por Pedro (1 intervención) el 28/06/2019 17:02:54
Saludos

Este código me funciona muy bien con varios archivos, pero con algunos otros no cuenta las hojas que incluye el archivo, por favor si ¿alguien más experimentado me puede ayudar a arreglar el problema?. Adjunto uno de los archivos con el cual no me funciona el programa.

De antemano, muchas gracias por su ayuda.

Atte.

Pedro Marza

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Test()
    Dim I As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
        Set xRg = Range("A1")
        Range("A:B").ClearContents
        Range("A1:B1").Font.Bold = True
        xRg = "File Name"
        xRg.Offset(0, 1) = "Pages"
        I = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(I, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As #xFileNum
                xStr = Space(LOF(xFileNum))
                Get #xFileNum, , xStr
            Close #xFileNum
            Cells(I, 2) = RegExp.Execute(xStr).Count
            I = I + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder