Escenario
(Actualizado y mejorado en Junio 2021)
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:
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:
Mejoras (junio 2021)
Se ha mejorado algo la aplicación, ahora está preparada para funcionar en Office de 32 bits y de 64 bits (no tenía contemplado vba para office de 64 bits, que se soluciona simplemente añadiendo PtrSafe tras cada Declare) y adicionalmente detecta automáticamente si se tiene Acrobat 11 o Acrobat DC, pues el código vba es distinto en cada caso. En Acrobat DC no funciona el marcado (highlight) de las palabras encontradas ni los marcadores (Acrobat lo eliminó de la API)
Enlace con los archivos (pdf, excel y acces) (Versión 5, junio 2021)
[…] búsqueda masiva en PDF, ya comentado en este blog, https://abrazalaweb.net/2019/03/busqueda-masiva-en-pdf-vba/, usa el módulo Clipboard (para pegar en Acrobat la cadena de texto […]
Cuando ejecuto la rutina en Visual Basic (el archivo pdfSearch_v4) me da el siguiente error: Error de compilación: El código de este proyecto se debe actualizar para usarse en sistemas de 64 bits.
Por si pudieras echarle un vistazo…. Gracias.
Sí, es un problema conocido al usar Office de 64 bits. El error aparece en el módulo de visual basic «clipboard», la corrección es muy sencilla para que funcione en un office de 64 bits, y es simplemente añadir «PtrSafe» después de cada «Declare».
Public Declare PtrSafe Sub Sleep Lib «kernel32» (ByVal dwMilliseconds As Long) ‘For 64 Bit Systems
Private Declare PtrSafe Function OpenClipboard Lib «user32.dll» (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib «user32.dll» () As Long
[…] etc….
He modificado y subido la aplicación con una última versión 5, que ademá, adicionalmente, detecta si se está usando Acrobat 11 o ACrobat DC, pues también hay cambios en el código según se use uno u otro (en Acrobat DC no funciona lo de resaltar las palabras encontradas en el pdf, ya que lo quitaron)
Muy buen artículo. Sólo necesitaba la primera parte para pasar a texto un pdf y la verdad es que funciona perfectamente.
Muchas gracias