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.
Any and all help is appreciated
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