0

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

现在我遇到的问题是,无论文件大小如何,宏都会随机停在随机文件上,而不做任何事情。除非我去移动鼠标,否则它只会保留在该文件上。

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

0 回答 0