clif
07-20-2023, 01:39 AM
Sub Search_PDFs_For_String()
Dim ws As Worksheet
Dim AcroPDDoc As Object
Dim AcroAVDoc As Object
Dim appObj As Object
Dim FSO As Object, FSOfolder As Object, FSOfile As Object
Dim searchString As String
Dim PDF_path As String
Dim blnSearch As Boolean
Dim lr As Long, r_output As Long
Set ws = ThisWorkbook.Worksheets("PDF_Search")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set AcroPDDoc = CreateObject("AcroExch.PDDoc")
'Excel environment - speed things up
' With Application
' .ScreenUpdating = False
' .DisplayAlerts = False
' .EnableEvents = False
' .Calculation = xlCalculationManual
' End With
'Get folder path and search phrase
With ws
PDF_path = .Range("A1").Value
searchString = .Range("A2").Value
.Range("A4:C4").Value = Split("Path,File,Found?", ",")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
If lr >= 5 Then .Range("A5:C5", .Cells(lr, "A")).ClearContents
r_output = 5
End With
'Search each file for the phrase
Set appObj = CreateObject("AcroExch.App")
Set FSOfolder = FSO.GetFolder(PDF_path)
For Each FSOfile In FSOfolder.Files
If LCase(FSOfile.Name) Like "*.pdf" Then
'Open the PDF file and check if the open was successful.
If AcroPDDoc.Open(FSOfile.Path) Then
Set AcroAVDoc = AcroPDDoc.OpenAVDoc("")
blnSearch = AcroAVDoc.findText(szText:=searchString, _
bCaseSensitive:=False, _
bWholeWordsOnly:=True, _
bReset:=2)
AcroAVDoc.Close bNoSave:=True
'log results
With ws
.Cells(r_output, 1).Value = FSOfile.Path
.Cells(r_output, 2).Value = FSOfile.Name
.Cells(r_output, 3).Value = blnSearch
End With
r_output = r_output + 1
DoEvents
End If
End If
Application.Wait (Now + TimeValue("0:00:02"))
Next
Set AcroAVDoc = Nothing
Set AcroPDDoc = Nothing
appObj.Exit
'Destroy objects
'Excel environment - restore
' With Application
' .ScreenUpdating = True
' .DisplayAlerts = True
' .EnableEvents = True
' .Calculation = xlCalculationAutomatic
' End With
End Sub
Why only the first one is okay, another is not working. Thanks!
Dim ws As Worksheet
Dim AcroPDDoc As Object
Dim AcroAVDoc As Object
Dim appObj As Object
Dim FSO As Object, FSOfolder As Object, FSOfile As Object
Dim searchString As String
Dim PDF_path As String
Dim blnSearch As Boolean
Dim lr As Long, r_output As Long
Set ws = ThisWorkbook.Worksheets("PDF_Search")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set AcroPDDoc = CreateObject("AcroExch.PDDoc")
'Excel environment - speed things up
' With Application
' .ScreenUpdating = False
' .DisplayAlerts = False
' .EnableEvents = False
' .Calculation = xlCalculationManual
' End With
'Get folder path and search phrase
With ws
PDF_path = .Range("A1").Value
searchString = .Range("A2").Value
.Range("A4:C4").Value = Split("Path,File,Found?", ",")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
If lr >= 5 Then .Range("A5:C5", .Cells(lr, "A")).ClearContents
r_output = 5
End With
'Search each file for the phrase
Set appObj = CreateObject("AcroExch.App")
Set FSOfolder = FSO.GetFolder(PDF_path)
For Each FSOfile In FSOfolder.Files
If LCase(FSOfile.Name) Like "*.pdf" Then
'Open the PDF file and check if the open was successful.
If AcroPDDoc.Open(FSOfile.Path) Then
Set AcroAVDoc = AcroPDDoc.OpenAVDoc("")
blnSearch = AcroAVDoc.findText(szText:=searchString, _
bCaseSensitive:=False, _
bWholeWordsOnly:=True, _
bReset:=2)
AcroAVDoc.Close bNoSave:=True
'log results
With ws
.Cells(r_output, 1).Value = FSOfile.Path
.Cells(r_output, 2).Value = FSOfile.Name
.Cells(r_output, 3).Value = blnSearch
End With
r_output = r_output + 1
DoEvents
End If
End If
Application.Wait (Now + TimeValue("0:00:02"))
Next
Set AcroAVDoc = Nothing
Set AcroPDDoc = Nothing
appObj.Exit
'Destroy objects
'Excel environment - restore
' With Application
' .ScreenUpdating = True
' .DisplayAlerts = True
' .EnableEvents = True
' .Calculation = xlCalculationAutomatic
' End With
End Sub
Why only the first one is okay, another is not working. Thanks!