在错误情况下强制退出Adobe对象

时间:2019-04-24 10:03:47

标签: excel vba pdf

嗨,我正在使用vba代码触发acrobat对象将PDF转换为Excel。该代码在很大程度上可以正常运行,但是在这之间,我们会收到与文件viz问题相关的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

1 个答案:

答案 0 :(得分: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