принудительно завершить объект Adobe в случае ошибки

Question

Привет! Я использую код VBA для запуска объекта Acrobat для преобразования PDF в Excel.Код в основном работает нормально, однако между ними мы получаем ошибки OLE, связанные с проблемами с файлом, а именно. «невозможно найти службу распознавания захвата бумаги» (при 507 итерациях цикла) и другие.Как я могу изменить свой код, чтобы пропустить в тех случаях, когда я получаю ошибку OLE и перейти к следующему выполнению.Кроме того, Как захватить, если файл успешно преобразован и захватить это в основном листе.Я читаю путь к файлу из столбца c и пишу, если файл был успешно экспортирован в D (см. Код)

Sub ExportAllPDFsText()



    Dim FileFormat As String
'    Dim gllyphpath As String
    Dim LastRow As Long
    Dim i As Integer
    Dim j As Integer

    'Change this according to your own needs.
    'Available formats: eps html, htm jpeg, jpg, jpe jpf, jpx, jp2,
    'j2k, j2c, jpc, docx, doc, png, ps, rft, xlsx, xls, txt, tiff, tif and xml.
    'In this example the PDF file will be saved as text file.
    FileFormat = "txt"

    If FileFormat = "" Then
        shPaths.Range("B2").Select
        MsgBox "There are no file paths to convert!", vbInformation, "File paths missing"
        Exit Sub
    End If

    shPaths.Activate

    'Find the last row.
    With shPaths
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    'Check that there are available file paths.
    If LastRow < 2 Then
        shPaths.Range("B2").Select
        MsgBox "There are no file paths to convert!", vbInformation, "File paths missing"
        Exit Sub
    End If

    'For each cell in the range "B2:B" & last row convert the pdf file
    'into different format (here to text - txt).
    For i = 2 To LastRow
'    For i = 2 To 2

        SavePDFAsOtherFormatNoMsg Cells(i, 2).Value, Cells(i, 3).Value, FileFormat,i
        'PdfToText Cells(i, 2).Value, Cells(i, 3).Value, i

        Next

    'Inform the user that conversion finished.
    MsgBox "All files were converted successfully!", vbInformation, "Finished"

End Sub

Sub SavePDFAsOtherFormatNoMsg(pdfPath As String, OutPath As String, FileExtension As String, c As Integer)

'C:\Program Files (x86)\Adobe\Acrobat 11.0\Acrobat

    Dim objAcroApp      As Acrobat.AcroApp
    Dim objAcroAVDoc    As Acrobat.AcroAVDoc
    Dim objAcroPDDoc    As Acrobat.AcroPDDoc
    Dim objJSO          As Object
    Dim boResult        As Boolean
    Dim ExportFormat    As String
    Dim NewFilePath     As String

    'Check if the file exists.
    If Dir(pdfPath) = "" Then
        Exit Sub
    End If

    'Check if the input file is a PDF file.
    If LCase(Right(pdfPath, 3)) <> "pdf" Then
        Exit Sub
    End If
    DeleteFile pdfPath
    'Initialize Acrobat by creating App object.
    Set objAcroApp = CreateObject("AcroExch.App")

    'Set AVDoc object.
    Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")

    'Open the PDF file.
    boResult = objAcroAVDoc.Open(pdfPath, "")

    'Set the PDDoc object.
    Set objAcroPDDoc = objAcroAVDoc.GetPDDoc

    'Set the JS Object - Java Script Object.
    Set objJSO = objAcroPDDoc.GetJSObject

    'Check the type of conversion.
    Select Case LCase(FileExtension)
        Case "eps": ExportFormat = "com.adobe.acrobat.eps"
        Case "html", "htm": ExportFormat = "com.adobe.acrobat.html"
        Case "jpeg", "jpg", "jpe": ExportFormat = "com.adobe.acrobat.jpeg"
        Case "jpf", "jpx", "jp2", "j2k", "j2c", "jpc": ExportFormat = "com.adobe.acrobat.jp2k"
        Case "docx": ExportFormat = "com.adobe.acrobat.docx"
        Case "doc": ExportFormat = "com.adobe.acrobat.doc"
        Case "png": ExportFormat = "com.adobe.acrobat.png"
        Case "ps": ExportFormat = "com.adobe.acrobat.ps"
        Case "rft": ExportFormat = "com.adobe.acrobat.rft"
        Case "xlsx": ExportFormat = "com.adobe.acrobat.xlsx"
        Case "xls": ExportFormat = "com.adobe.acrobat.spreadsheet"
        Case "txt": ExportFormat = "com.adobe.acrobat.accesstext"
        Case "tiff", "tif": ExportFormat = "com.adobe.acrobat.tiff"
        Case "xml": ExportFormat = "com.adobe.acrobat.xml-1-00"
        Case Else: ExportFormat = "Wrong Input"
    End Select

    'Check if the format is correct and there are no errors.
    If ExportFormat <> "Wrong Input" And Err.Number = 0 Then

        'Format is correct and no errors.

        'Set the path of the new file. Note that Adobe instead of xls uses xml files.
        'That's why here the xls extension changes to xml.
        If LCase(FileExtension) <> "xls" Then
            NewFilePath = WorksheetFunction.Substitute(OutPath, ".pdf", "_adobeConverted" & "." & LCase(FileExtension))
        Else
            NewFilePath = WorksheetFunction.Substitute(OutPath, ".pdf", "_adobeConverted" & ".xml")
        End If

        DeleteFile NewFilePath

        'Save PDF file to the new format.
        boResult = objJSO.SaveAs(NewFilePath, ExportFormat)

        'Close the PDF file without saving the changes.
        boResult = objAcroAVDoc.Close(True)

        'Close the Acrobat application.
        boResult = objAcroApp.exit

        If FileExtension = "xlsx" Then
        Cells(c, 4).Value = "YES"
        ElseIf FileExtension = "txt" Then
        Cells(c, 5).Value = "YES"
        End If
    Else

        'Something went wrong, so close the PDF file and the application.

        'Close the PDF file without saving the changes.
        boResult = objAcroAVDoc.Close(True)

        'Close the Acrobat application.
        boResult = objAcroApp.exit
        If FileExtension = "xlsx" Then
        Cells(c, 4).Value = "NO"
        ElseIf FileExtension = "txt" Then
        Cells(c, 5).Value = "NO"
        End If
    End If

    'Release the objects.
    Set objAcroPDDoc = Nothing
    Set objAcroAVDoc = Nothing
    Set objAcroApp = Nothing

End Sub

Answer 1

Включить обработку ошибок в SavePDFAsOtherFormatNoMsg. Таким образом, код не сломается и выйдет из подпрограммы изящно. Также измените его с Sub на Function, которые возвращают логическое значение.

Вот пример ( Не проверено )

Dim tmpPath As String

Sub ExportAllPDFsText()
    Dim success As Boolean
    '
    '~~> Rest of the code
    '

    For i = 2 To LastRow
        success = SavePDFAsOtherFormatNoMsg(Cells(i, 2).Value, Cells(i, 3).Value, FileFormat, i)

        '~~> I am taking Cells(i, 10) as an example
        '~~> Use some other cell where you want the output
        If success = False Then
            Cells(i, 10).Value = "File Not Saved"
        Else
            '~~> Double check if the file was created
            If Dir(tmpPath) <> "" Then _
            Cells(i, 10).Value = "File Saved Successfully"
        End If
    Next i

    '
    '~~> Rest of the code
    '
End Sub

Function SavePDFAsOtherFormatNoMsg(pdfPath As String, OutPath As String, _
FileExtension As String, c As Integer) As Boolean
    tmpPath = ""

    On Error GoTo Whoa

    '
    '~~> Rest of the code
    '

    tmpPath = NewFilePath
    SavePDFAsOtherFormatNoMsg = True

    Exit Function
Whoa: 
    '<~~ Exit function. If you wish you can show error message here
End Function