Excel 如果代码执行时间过长，有没有办法在for循环中加入计时器？

我有一个VBA宏，它循环浏览1500个PDF文件的列表，从60页到500页不等。代码检查列表中的每个文件，查看它是否包含从用户处获得的某个关键字。如果文件太大，代码有时会出错，因此我将搜索的每个pdf限制为12MB

现在我遇到的问题是，随机宏只会在随机文件上暂停，而不管文件大小如何，都不会执行任何操作。除非我去移动鼠标，否则它将一直保留在该文件中

所以我想知道解决这个问题的最好方法是什么？我曾考虑在.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

Sub-PDFSearch（）
将文件列表设置为工作表，将结果设置为工作表
将最后一行变暗为长，文件大小为长
Dim关键字作为字符串
Dim TooLarge作为布尔值
Dim PDFApp作为对象，PDFDoc作为对象
Application.DisplayAlerts=False
Set FileList=此工作簿。工作表（“文件”）
设置结果=此工作簿。工作表（“结果”）
LastRow=FileList.Cells（Rows.Count，1）.End（xlUp）.Row
关键字=输入框（“您希望搜索哪个术语？”）
Results.Rows（3&“：”&.Rows.Count）.ClearContents
对于x=3到最后一行
TooLarge=False
FileSize=FileLen（FileList.Cells（x，1.Value）/1000
如果文件大小>12000，则TooLarge=True
如果TooLarge=False，则
设置PDFApp=CreateObject（“AcroExch.App”）
如果错误号为0，则
MsgBox“无法创建Adobe应用程序对象！”，vbCritical，“对象错误”
设置PDFApp=Nothing
出口接头
如果结束
出错时继续下一步
App.CloseAllDocs的预防措施-有时它不会关闭文件
错误转到0
设置PDFDoc=CreateObject（“AcroExch.AVDoc”）
如果错误号为0，则
MsgBox“无法创建AVDoc对象！”，vbCritical，“对象错误”
设置PDFDoc=Nothing
设置PDFApp=Nothing
出口接头
如果结束
如果PDFDoc.Open（FileList.Cells（x，1）.Value，”）=True，则
PDFDoc.BringToFront
如果PDFDoc.FindText（关键字，False，False，True）=True，则
Results.Range（“B”和Rows.Count）.End（xlUp）.Offset（1，0）.Value=FileList.Cells（x，1）.Value
如果结束
如果结束
PDFApp.出口
如果结束
出错时继续下一步
PDFDoc.BringToFront的预防措施-有时命令不会关闭文件
PDFApp.出口
错误转到0
设置PDFDoc=Nothing
设置PDFApp=Nothing
文件大小=0
下一个x
Application.DisplayAlerts=True
端接头

为什么需要同时打开

PDFApp

和

PDFDoc

？我原以为你可以打开应用程序一次（在循环之外），然后在找到每个文档时打开它们。无论如何，API看起来都很混乱。你看过了吗？不为每个迭代创建和关闭

PDFApp

，可能会有助于提高性能。除此之外，看起来还有很多I/O工作。。。要加快这一速度，人们所能做的不多（将硬盘换成固态硬盘可能有所帮助，但这是硬件，而不是代码）。至于一般的反馈和建议，这是你想问的。问题是，如果我移动鼠标，它不会花很长时间，我想在晚上运行它，而不是每5分钟移动鼠标一次，它似乎进入睡眠状态。我将更改代码，使应用程序保持打开状态，也许这样可以修复它。