0

I have a VBA macro that cycles through a list of 1500 PDF Files Ranging from 60 to 500 pages. The code checks each file from the list to see if it contains a certain keyword obtained from a user. The code seems to bug out sometimes if the file is too big, so I limited each pdf that will be searched to 12 MB.

Now The problem I am having is that randomly the macro will just stall on a random file and not do anything regardless of file size. It will just stay on that file unless I go and move the mouse.

So I was wondering what the best way to tackle this would be? I was thinking of adding an event of moving the mouse before and after the .FindText method, but I think the best way would be to limit the time each file is open to 30 seconds. I am not sure how to incorporate it within the loop though, Thanks.

Also if you have any suggestions on other improvements I would aprreciate it thank you.

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
David Podolak
  • 195
  • 2
  • 10
  • 1
    Why do you need to open both the `PDFApp` and the `PDFDoc`? I would have thought you could open the App once (outside the loop) and then just open each Doc as they are found. The API looks confusing in any case. Have you looked at [this answer](https://stackoverflow.com/a/29069609/4717755)? – PeterT Nov 07 '19 at 16:35
  • 1
    Not creating and closign the `PDFApp` for every single iteration would probably help performance here. Other than that, looks like a lot of I/O work... not much one can do to speed that up (swapping HDDs for SSDs can help, but that's hardware, not code). As for general feedback and suggestions, that's something you'll want to ask for on [codereview.se]. – Mathieu Guindon Nov 07 '19 at 17:07
  • The thing is if I move the mouse then it does not take long at all, I would like to run it over night rather than move the mouse every 5 min, it seems to go into a sleep. I will change my code to leave the app open, maybe that will fix it. – David Podolak Nov 07 '19 at 17:11

0 Answers0