Есть ли способ включить таймер в цикл for для цикла, если выполнение кода занимает слишком много времени? - PullRequest
0 голосов
/ 07 ноября 2019

У меня есть макрос 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...