在错误条件下强制退出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