pdfSearch

Búsqueda masiva en pdf (vba)

Escenario

Se trata de realizar una búsqueda masiva, de muchos términos o palabras en un documento pdf. Para ello partimos de una tabla excel con las palabras a buscar en la primera columna. El pdf ha de ser editable.

Para ello usaremos visual basic para aplicaciones (VBA) y Microsoft Access. Será necesario también disponer de Acrobat Standard o profesional (para disponer de la librería acrobat.tlb)

Al final adjunto video con la demostración y enlace para descargar los archivos usados.

Existen varias técnicas para llevar a cabo búsquedas en un pdf mediante vba, algunas de ellas:

https://stackoverflow.com/questions/29773754/how-to-finda-text-and-get-the-page-no-for-acrobat-using-vba

http://myengineeringworld.net/2014/05/pdf-search-through-vba.html

Sin embargo, para realizar una búsqueda masiva (un bucle de las anteriores rutinas sobre muchas palabras) resulta extremadamente lento e inviable.

Por eso, una manera más rápida y eficiente es realizar primero un bucle sobre todas las páginas del pdf, insertando el texto en un array y luego realizar un bucle sobre las palabras buscándolas en los array (con un simple string compare), la diferencia de tiempo es brutal (se tarda unos pocos segundos)

El siguiente código es la parte que va metiendo en un array el texto de cada página del pdf:

Dim pdfTxt(500) As Variant 'Array con el texto de cada página del pdf
' cargar pdf
Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
' pathPdf ruta al archivo
If AcroAVDoc.Open(pathPdf, vbNull) <> True Then Exit Sub 
Set AcroPDDoc = AcroAVDoc.GetPDDoc
iNumPages = AcroPDDoc.GetNumPages

tiempo = Timer


' controlar status
progreso.Caption = "Pasando pdf"
DoEvents

If isCancelled Then
   Exit Sub
End If
Content = ""
For i = 0 To iNumPages - 1
    progreso.Caption = "Procesando pdf página " & i + 1 & " / " & iNumPages
    DoEvents
    Set PageNumber = AcroPDDoc.AcquirePage(i)  ' devuelve un PDPage  
    Set PageContent = CreateObject("AcroExch.HiliteList")
    If PageContent.Add(0, 10000) <> True Then Exit Sub
    Set AcroTextSelect = PageNumber.CreatePageHilite(PageContent)
    ' The next line is needed to avoid errors with protected PDFs that can't be read
    On Error Resume Next
    For j = 0 To AcroTextSelect.GetNumText - 1
        Content = Content & AcroTextSelect.GetText(j)
    Next j
   
    ' asignamos texto al vector
    pdfTxt(i) = Content
    Content = ""
    
Next i

Una vez el texto del pdf en el array, se hace un bucle sobre la tabla (importada a la base de datos de Microsoft access como un recordset), y se va buscando y añadiendo en una columna nueva las páginas donde se van encontrando (LIMITACIÓN: Sólo la primera ocurrencia en cada página, si en una mima página hay dos ocurrencias, la segunda no se contabiliza)

' cargar tabla excel
Set rs = CurrentDb.OpenRecordset("excel")
rs.MoveFirst
k = 0
strResult = ""
count = 0
Do Until rs.EOF
    ' controlar status
    progreso.Caption = "Buscando " & k + 1 & " / " & rs.RecordCount
    DoEvents
    
    If isCancelled Then
        'rs.Update
        rs.Close
        Exit Sub
    End If
    
    SearchString = rs(0)
    'count = 0
    bReset = True
    For j = 0 To iNumPages - 1
        If InStr(1, LCase(pdfTxt(j)), LCase(SearchString)) > 0 Then
            strResult = IIf(strResult = "", j + 1, strResult & "," & j + 1)
            count = count + 1
        End If
    Next j
    rs.Edit
    rs(1) = strResult
    rs.Update
    rs.MoveNext
    k = k + 1
    strResult = ""
Loop

En las siguientes capturas de pantalla se muestra el proceso, se carga el pdf, el excel y al pulsar el botón buscar se ejecutan los dos bucles anteriores:

(en este caso he elegido un BOE con el reglamento de aditivos alimentarios y una tabla excel con una búsqueda de 7 elementos (el último a propósito para que no lo encuentre):

La siguiente captura muestra que en el access, en la tabla importada se ha insertado una columna con las páginas (separadas por comas) donde se ha encontrado al menos una ocurrencia de la palabra que se busca (primera columna), si no se encuentra, aparece vacío el campo.

Puede ser que con esto ya estemos satisfechos, pero una mejora, es crear en el pdf marcadores para cada ocurrencia y resaltar en amarillo dichas ocurrencias en cada página (tal como mostraba el pop up al finalizar la ejecución de la búsqueda).

En este caso algunas referencias que he encontrado son:

http://www.utteraccess.com/forum/index.php?showtopic=2043520, http://www.justskins.com/forums/how-to-create-a-74965.html,https://forums.adobe.com/thread/468174

Hay que tener en cuenta que para Acrobat DC esto no va a funcionar: https://forums.adobe.com/thread/1992563

La técnica usada es ir recorriendo el recorset con cada palabra y las páginas donde se han encontrado cada término, usar mediante vba los items del menú de acrobat para buscar y resaltar el término. Volver al inicio del documento y comenzar con la siguiente palabra (es necesario usar un módulo de portapapeles, clipboard para ir pegando en el menú buscar la palabra https://docs.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard . Para que funcione bien es mejor no tocar el ordenador ya que al ir ejecutando el programa acciones de menú, se puede interferir y fastidiar el proceso. Entre la ejecución de cada comando hay que ir poniendo una pausa para darle tiempo al acrobat

Const PAUSA = 115 ' milisegundos, Pausa para todos
Const Delta_PAUSA = 60 ' milisegundos, Incrementar la pausa en ciertos comandos

' Declaraciones para la función Sleep en VBA (tienen que ir al principio o en un módulo aparte, yo la he puesto en el módulo clipboard)
 #If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems

La rutina es la siguiente:

Set PDBookmark = CreateObject("AcroExch.PDBookmark", "")
Set AVPageview = AcroAVDoc.GetAVPageView

If AcroApp.GetLanguage = "ESP" Then
    bkmDefault = "Sin título"
ElseIf AcroApp.GetLanguage = "ENU" Then
    bkmDefault = "Untitled"
Else
    MsgBox ("Añadir título del bookmark al crearlo por defecto")
    Exit Sub
End If
AcroAVDoc.SetViewMode 3 ' abrir con bookmarks
AcroApp.Show ' Tiene que verse en la pantalla para que funcionen los menuitemExecute

'inicializar
intParentIndex = 0
intChildIndex = 0

rs.MoveFirst
k = 0
strResult = ""
tiempo = Timer


Do Until rs.EOF
    progreso.Caption = "Marcadores y resaltado: " & k + 1 & " / " & rs.RecordCount
    If isCancelled Then
        Exit Sub
    End If
    DoEvents
    
    intChildIndex = 0
    ' solo para los encontrados
    If rs(1) <> "" Then
        AVPageview.GoTo (0) 'Volvemos a la primera página, porque si hay palabras repetidas que sólo se encuentran una vez
                        'da error de "no se encuentran más..." es como reinicializar el puntero del doc
        Sleep PAUSA
        ocurrencia = Split(rs(1), ",", , vbTextCompare)
        ocurrencias = UBound(ocurrencia) - LBound(ocurrencia) + 1
        ' hay que moverse a la página en cuestión y crear el bookmark ahí
        bookmarkTxt = rs(0)
        SetClipboard (bookmarkTxt) ' copiar al portapapeles
        For j = 0 To ocurrencias - 1
            ' crear el marcador
           pageNum = ocurrencia(j)
            AVPageview.GoTo (pageNum - 1)
            Sleep PAUSA
            AcroApp.MenuItemExecute ("NewBookmark")
            fResult = PDBookmark.GetByTitle(AcroPDDoc, bkmDefault) ' al crear el bookmark el nombre por defecto es "Sin título"
            fResult = PDBookmark.SetTitle(bookmarkTxt)
            Sleep PAUSA
            ' highligth
            AcroApp.MenuItemExecute ("Find") ' abre menu buscar
            Sleep PAUSA
            AcroApp.MenuItemExecute ("Paste") ' cogemos del portapapeles
            Sleep PAUSA
            AcroApp.MenuItemExecute ("FindAgain")
            ' hay que hacer una pequña pausa, en debug paso a paso funciona
            Sleep PAUSA + Delta_PAUSA ' milisegundos
            AcroApp.MenuItemExecute ("Annots:TextEditMenu:HighlightSel")
            'AcroApp.MenuItemExecute ("HighlightSel")
            Sleep PAUSA + Delta_PAUSA
            ' indentar si es un hijo añadir hijo (movemos el marcador creado)
            If j > 0 Then ' desde k=1 hay más de una ocurrencia, lo pongo como hijo
                Set jso = AcroPDDoc.GetJSObject
                arrParents = jso.BookmarkRoot.children 'array de padres,
                Set bkmChild = arrParents(intParentIndex + 1)
                Set bkmChildsParent = arrParents(intParentIndex)
                'bkmchildsparetn.createChild "Child", 0
                bkmChildsParent.insertchild bkmChild, intChildIndex
                intChildIndex = intChildIndex + 1
            Else ' no hay que indentar
                intChildIndex = 0
            End If
        Next j
        intParentIndex = intParentIndex + 1 ' acumulamos para el siguiente
    End If
    'Sleep PAUSA
    rs.MoveNext
    k = k + 1
    'MsgBox ("tiempo registro encontrado " & k & " veces " & Timer - tiempo)
Loop
rs.Close
Set rs = Nothing
Set jso = Nothing



' guardar pdf
newPathPdf = Left(pathPdf, Len(pathPdf) - 4) & "_search.pdf"

fResult = AcroPDDoc.Save(1, newPathPdf)
'MsgBox ("tiempo " & Timer - tiempo)

Cuando todo acaba, se nos ha guardado un nuevo archivo (que se abre automáticamente) con marcadores para cada página donde se encuentra una ocurrencia, resaltando ésta.

Video demo:

Enlace con los archivos (pdf, excel y acces)

Leave a Reply

Tu dirección de correo electrónico no será publicada.

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.