У меня есть макрос VBA, который циклически перебирает список из 1500 PDF-файлов в диапазоне от 60 до 500 страниц. Код проверяет каждый файл из списка, чтобы увидеть, содержит ли он определенное ключевое слово, полученное от пользователя. Кажется, код иногда дает ошибку, если файл слишком большой, поэтому я ограничил каждый файл PDF, в котором будет производиться поиск, до 12 МБ. файл и ничего не делать независимо от размера файла. Он просто останется в этом файле, если я не пойду и не переместлю мышь.
Так что мне было интересно, каким будет лучший способ справиться с этим? Я думал о добавлении события перемещения мыши до и после метода .FindText, но я думаю, что лучшим способом было бы ограничить время открытия каждого файла до 30 секунд. Я не уверен, как включить это в цикл, спасибо.
Также, если у вас есть какие-либо предложения по другим улучшениям, я бы оценил это спасибо.
Sub PDFSearch()
Dim FileList As Worksheet, Results As Worksheet
Dim LastRow As Long, FileSize As Long
Dim KeyWord As String
Dim TooLarge As Boolean
Dim PDFApp As Object, PDFDoc As Object
Application.DisplayAlerts = False
Set FileList = ThisWorkbook.Worksheets("Files")
Set Results = ThisWorkbook.Worksheets("Results")
LastRow = FileList.Cells(Rows.Count, 1).End(xlUp).Row
KeyWord = InputBox("What Term Would You Like To Search For?")
Results.Rows(3 & ":" & .Rows.Count).ClearContents
For x = 3 To LastRow
TooLarge = False
FileSize = FileLen(FileList.Cells(x, 1).Value) / 1000
If FileSize > 12000 Then TooLarge = True
If TooLarge = False Then
Set PDFApp = CreateObject("AcroExch.App")
If Err.Number <> 0 Then
MsgBox "Could not create the Adobe Application object!", vbCritical, "Object Error"
Set PDFApp = Nothing
Exit Sub
End If
On Error Resume Next
App.CloseAllDocs 'Precautionary - Sometimes It Doesn't Close The File
On Error GoTo 0
Set PDFDoc = CreateObject("AcroExch.AVDoc")
If Err.Number <> 0 Then
MsgBox "Could not create the AVDoc object!", vbCritical, "Object Error"
Set PDFDoc = Nothing
Set PDFApp = Nothing
Exit Sub
End If
If PDFDoc.Open(FileList.Cells(x, 1).Value, "") = True Then
PDFDoc.BringToFront
If PDFDoc.FindText(KeyWord, False, False, True) = True Then
Results.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = FileList.Cells(x, 1).Value
End If
End If
PDFApp.Exit
End If
On Error Resume Next
PDFDoc.BringToFront 'Precautionary - Sometimes Command Doesn't Close The File
PDFApp.Exit
On Error GoTo 0
Set PDFDoc = Nothing
Set PDFApp = Nothing
FileSize = 0
Next x
Application.DisplayAlerts = True
End Sub