Modification required in VBA PDF to excel conversion

Zahid0111

New Member
Joined
Mar 8, 2020
Messages
23
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
The following VBA converts PDF file to excel. But i need some modification with it, At address A2 path of PDF file is entered and at B2 type is selected like .xlsx. When convert button is pressed it converts PDF to excel at same location.
Now what i want with this code to be modified is that:
1) It should ask from user to select PDF file(by using application.open method) and by default it should convert to xlsx format.
2) Sheet should be named as "Farmer History" to which data is copied
3) Headings to be ignored during copy
VBA Code:
Option Explicit
Option Private Module

Sub ExportAllPDFs()
    
    '----------------------------------------------------------------
    'Converts all the PDF files that their paths are in column A of
    'the worksheet "Convert PDF Files" into a different file format,
    'based on the value in column B (extension).
    

    Dim LastRow As Long
    Dim i As Integer
    
    shPaths.Activate
    
    'Find the last row.
    With shPaths
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    'Check that there are available file paths.
    If LastRow < 2 Then
        shPaths.Range("A2").Select
        MsgBox "There are no file paths to convert!", vbInformation, "File paths missing"
        Exit Sub
    End If
        
    'Checking for errors before conversion.
    For i = 2 To LastRow
    
        'Check if the file extensions are not empty.
        If Cells(i, 2).Value = "" Then
            shPaths.Cells(i, 2).Select
            MsgBox "Please select an output format from the dropdown list!", vbCritical, "File paths missing"
            Exit Sub
        End If
        
        'Check if the file exists.
        If Dir(shPaths.Cells(i, 1).Value) = "" Then
            shPaths.Cells(i, 1).Select
            MsgBox "The file path is not valid!", vbCritical, "File path error"
            Exit Sub
        End If
    
        'Check if the input file is a PDF file.
        If LCase(Right(shPaths.Cells(i, 1).Value, 3)) <> "pdf" Then
            shPaths.Cells(i, 1).Select
            MsgBox "The file is not a pdf file!", vbCritical, "No pdf file"
            Exit Sub
        End If
        
    Next i
    
    'For each cell in the range "A2:A" & last row convert the pdf file
    'into different format according to the "B2:B" & last row value.
    For i = 2 To LastRow
        SavePDFAs Cells(i, 1).Value, Cells(i, 2).Value
    Next i
    
    'Adjust the two columns.
    Columns("A:B").EntireColumn.AutoFit
     
    'Inform the user that conversion finished.
    MsgBox "All files were converted successfully!", vbInformation, "Finished"
    
End Sub

Private Sub SavePDFAs(PDFPath As String, FileExtension As String)
    
    '---------------------------------------------------------------------------------------
    'Saves a PDF file as other format using Adobe Professional.
    
    'In order to use the macro you must enable the Acrobat library from VBA editor:
    'Go to Tools -> References -> Adobe Acrobat xx.0 Type Library, where xx depends
    'on your Acrobat Professional version (i.e. 9.0 or 10.0) you have installed to your PC.
    
    'Alternatively you can find it Tools -> References -> Browse and check for the path
    'C:\Program Files\Adobe\Acrobat xx.0\Acrobat\acrobat.tlb
    'where xx is your Acrobat version (i.e. 9.0 or 10.0 etc.).
    
    '---------------------------------------------------------------------------------------
    
    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
        
    '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(PDFPath, ".pdf", "." & LCase(FileExtension))
        Else
            NewFilePath = WorksheetFunction.Substitute(PDFPath, ".pdf", ".xml")
        End If
        
        '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
        
    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

    End If
        
    'Release the objects.
    Set objAcroPDDoc = Nothing
    Set objAcroAVDoc = Nothing
    Set objAcroApp = Nothing
        
End Sub
 

Attachments

  • path.PNG
    path.PNG
    7.4 KB · Views: 14

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Watch MrExcel Video

Forum statistics

Threads
1,129,530
Messages
5,636,855
Members
416,945
Latest member
Himu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top