Как остановить поиск в al oop после того, как поисковый запрос найден? - PullRequest
0 голосов
/ 02 марта 2020

Я сжал все свои PDF-файлы в один файл.

Код перебирает все страницы даже после того, как он нашел условие поиска, и не получает номер страницы до тех пор, пока не будет.

Это работает очень медленно. Я хотел бы изменить этот код, чтобы он работал быстрее. Книгу нужно открыть только один раз.

Sub FetchMultiplePDF()
Dim SearchResult As String
Dim i As Integer, weld As Integer, report As Integer
Dim search As String, iName As String, Filepath As String, FileName As String

weld = Range("Weld").Column
lrow = Cells(Rows.Count, weld).End(xlUp).Row
For i = 5 To lrow
    search = Cells(i, weld)

    FileType = Range("FileType")
    report = Range("SearchFor").Column
    iName = Cells(i, report)
    Filepath = Range("File_Path")

    FileName = (Filepath & iName & "." & FileType)

    SearchResult = AdobePdfSearch(search, FileName)
    Range("N" & i) = SearchResult
    'MsgBox SearchResult
Next i
End Sub


Function AdobePdfSearch(SearchString As String, strFileName As String) As 
String
'Note: A Reference to the Adobe Library must be set in Tools|References!
'Note! This only works with Acrobat Pro installed on your PC, will not 
work with Reader
Dim AcroApp As CAcroApp, AcroAVDoc As CAcroAVDoc, AcroPDDoc As CAcroPDDoc
Dim AcroHiliteList As CAcroHiliteList, AcroTextSelect As CAcroPDTextSelect
Dim PageNumber, PageContent, Content, i, j, iNumPages
Dim strResult As String

Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
If AcroAVDoc.Open(strFileName, vbNull) <> True Then Exit Function

Set AcroPDDoc = AcroAVDoc.GetPDDoc
iNumPages = AcroPDDoc.GetNumPages
For i = 0 To iNumPages - 1
    Set PageNumber = AcroPDDoc.AcquirePage(i)
    Set PageContent = CreateObject("AcroExch.HiliteList")
    If PageContent.Add(0, 9000) <> True Then Exit Function
    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
    If InStr(1, LCase(Content), LCase(SearchString)) > 0 Then
        strResult = IIf(strResult = "", i + 1, strResult & "," & i + 1)
    End If
    Content = ""
Next i

AdobePdfSearch = strResult

'Uncomment the lines below if you want to close the PDF when done.
AcroAVDoc.Close True
AcroApp.Exit
End Function
...