强制在错误条件下退出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。同时将它从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