Searching for Text in Multiple PDFs and Returning File Name

turtlepokerman

New Member
Joined
Jun 18, 2012
Messages
28
Greetings,

I'm trying to write a VBA script where I can Search through numerous PDFs in a folder and search for a particular string in the pdfs. In column "A" I have my list of strings that I am looking for in every pdf. The script then opens every PDF and searches for that string. If the string is found then it records the filename in columns B,C,D,etc... Once the script cycle through all of the pdfs then it moves onto the next string and so on and so forth. I am pretty novice when it comes to VBA programming, but with the help of other's code posted online I was able to assemble the below working script. Please Note: Adobe Acrobat Pro is required to run the below script.

There are a few things that I would like to improve on the script to try and speed it up and any recommendations would be greatly appreciated.
1. Right now the PDF pops up whenever it attempts to find the text. This is not necessary and is a waste of computational power, even though it provides a great strobe effect for parties.
2. I want to be able to only open the pdf once and search for multiple strings that are listed in column "A". Similar to how the Advanced Find Feature works in Adobe DC.
3. I've had to program in a Application.Wait() to avoid getting OLE errors. Right now I have to manually change the time based on the size of the pdfs in the folder. Is there a way to check OLE work is complete without having to program in a delay?
4. I have read about the PDdoc object, but I am unfamiliar with its use and if there is something I can directly translate my AVDoc objects to PDdoc objects. I think this would solve some of my problems.

VBA Code:
Sub searchUsingAcrobatPro()

Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim PDF_path As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Files() As String
Dim element As Variant
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & "\"
    End With
    
'In Case of Cancel
NextCode:

'Target File Extension (must include wildcard "*")
  myExtension = "*.pdf*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each PDF file in folder
  i = 0
  Do While myFile <> ""
    'Set variable equal to opened workbook
      PDF_path = myPath & myFile
      ReDim Preserve Files(i)
      Files(i) = myFile
      i = i + 1
      myFile = Dir()
  Loop

'Code Below this line is for PDF Searching
    Dim searchString As String
    Dim appObj As Object, AVDocObj As Object
               
    'First Line of Data
    Range("A1").Select
    'Set Do loop to stop when an empty cell is reached
    Do Until IsEmpty(ActiveCell)
        searchString = ActiveCell.Value
        j = 0
        k = 1
        Debug.Print searchString
        For Each element In Files
            PDF_path = myPath & Files(j)
            Debug.Print Files(j)
           
            'Check if the file exists.
            If Dir(PDF_path) = "" Then
                MsgBox "File not found..."
                Exit Sub
            End If
           
            On Error Resume Next
            
            'Create Adobe Application object.
            Set appObj = CreateObject("AcroExch.App")
            
            'Check for any errors.
            If Err.Number <> 0 Then
                MsgBox "Error in creating the Adobe Application object..."
                Set appObj = Nothing
                Exit Sub
            End If
            
            'Create the AVDoc object.
            Set AVDocObj = CreateObject("AcroExch.AVDoc")
            
            'Check for any errors.
            If Err.Number <> 0 Then
                MsgBox "Error in creating the AVDoc object..."
                Set AVDocObj = Nothing
                Set appObj = Nothing
                Exit Sub
            End If
            
            On Error GoTo 0
            
            'Open the PDF file and check if the open was successful.
            If AVDocObj.Open(PDF_path, "") = True Then
                
                'Bring the PDF file to the front.
                AVDocObj.BringToFront
                
                'Search for the string and check if the the string was found.
                'If text is found, it will be highlighted (PDF is already in focus)
                If AVDocObj.findtext(searchString, False, False, False) = False Then
                    Application.Wait (Now + 0.000004)
                    'If text was not found, close the PDF file and perform clean-up
                    AVDocObj.Close True
                    appObj.Exit
                       
                    'Release the objects.
                    Set AVDocObj = Nothing
                    Set appObj = Nothing
                    
                    
                    'MsgBox "The string not found in the PDF file..."
                Else
                    ActiveCell.Offset(0, k).Value = Files(j)
                    k = k + 1
                End If
                
            Else
                'PDF file failed to open
                appObj.Exit
        
                'Release the objects.
                Set AVDocObj = Nothing
                Set appObj = Nothing
                
                MsgBox "Could not open the PDF file..."
                
            End If
            j = j + 1
        Next element
    'Iterates the Loop Down Cell to the next tag
    ActiveCell.Offset(1, 0).Select
    Loop
    
    'Message Box when tasks are completed
  MsgBox "Task Complete!"
    
ResetSettings:
    
End Sub

Any and all help is appreciated
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Forum statistics

Threads
1,224,828
Messages
6,181,209
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top