嗨,我正在使用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
答案 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