PDF to excel worksheet -- instead of PDF to Excel workbook

[Omarom]

I found this code which convert multiple PDF documents from the folder called "pdf" to another folder called "excel"
if the pdf files named : "61.pdf" & "62.pdf" & "63.pdf" -- then the output is "61.xlsx" & "62.xlsx" & "63.xlsx"... etc
-------------------------
The problem is : I want to change this code to convert a multiple PDF documents to "One" workbook , with worksheets names ( "61", "62, .. etc)
---------------------------------
Any one can help me ?
excel file which convert *.PDF to *.xlsx
here is the code :

[/CODE]

Sub PDF_To_Excel()

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AlertBeforeOverwriting = False
    Application.EnableEvents = False

    Dim ws As Worksheet, pdf_path As String, excel_path As String
    Set ws = ThisWorkbook.Sheets("Macro")
    pdf_path = ws.Range("B3").Value
    excel_path = ws.Range("B5").Value
    Dim fso As New FileSystemObject, fo As Folder, f As File, wa As Object, doc As Object, wr As Object, nwb As Workbook, nsh As Worksheet
    If pdf_path = "" Or excel_path = "" Then
        MsgBox "please fill the empty cells"
        Exit Sub
        Else
        Set fo = fso.GetFolder(pdf_path)
        Set wa = CreateObject("word.application")
        wa.Visible = False
            For Each f In fo.Files
                Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files")
    AutomationSecurity = Microsoft.Office.Core.MsoAutomationSecurity.msoAutomationSecurityForceDisable
                Set wr = doc.Paragraphs(1).Range
                wr.WholeStory
                Set nwb = Workbooks.Add
                Set nsh = nwb.Sheets(1)
                wr.Copy
                nsh.Paste
                nwb.SaveAs (excel_path & Replace(f.Name, ".pdf", ".xlsx"))
                doc.Close
               nwb.Close
            Next
        wa.Quit
    End If
    AutomationSecurity = Microsoft.Office.Core.MsoAutomationSecurity.msoAutomationSecurityForceenable
    Application.DisplayAlerts = True
    Application.AlertBeforeOverwriting = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

 

[Rino702]

Hello Omaron,

Here the code macro adapted for your needs.

Sub PDF_To_Excel()
Const wdDoNotSaveChanges = 0
Dim fso As Object, fo As Object, f As Object, wa As Object, doc As Object, wr As Object, nws As Worksheet
Dim ws As Worksheet, pdf_path As String

    Set ws = ThisWorkbook.Sheets("Macro")
    pdf_path = ws.Range("B3").Value
    Set fso = CreateObject("Scripting.FileSystemObject")
    If pdf_path = "" Or excel_path = "" Then
        MsgBox "please fill the empty cells"
        Exit Sub
    Else
        Set fo = fso.GetFolder(pdf_path)
        Set wa = CreateObject("word.application")
        wa.Visible = True
        For Each f In fo.Files
            Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files", ReadOnly:=True)
            Set wr = doc.Paragraphs(1).Range
            wr.WholeStory
            Set nws = Sheets.Add
            nws.Name = Left(f.Name, InStrRev(f.Name, ".pdf", -1, vbTextCompare) - 1)
            wr.Copy
            nws.Range("A1").Select
            ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
            cutcopypaste = False
            wa.documents.Close SaveChanges:=wdDoNotSaveChanges
        Next
        wa.Quit
    End If
End Sub

The execute this macro you need to create a sheet Macro with in the cell B3 the folder path of the pdf files.

Regards

 

[Omarom]

Hello Omaron,

Here the code macro adapted for your needs.

Sub PDF_To_Excel()
Const wdDoNotSaveChanges = 0
Dim fso As Object, fo As Object, f As Object, wa As Object, doc As Object, wr As Object, nws As Worksheet
Dim ws As Worksheet, pdf_path As String

    Set ws = ThisWorkbook.Sheets("Macro")
    pdf_path = ws.Range("B3").Value
    Set fso = CreateObject("Scripting.FileSystemObject")
    If pdf_path = "" Or excel_path = "" Then
        MsgBox "please fill the empty cells"
        Exit Sub
    Else
        Set fo = fso.GetFolder(pdf_path)
        Set wa = CreateObject("word.application")
        wa.Visible = True
        For Each f In fo.Files
            Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files", ReadOnly:=True)
            Set wr = doc.Paragraphs(1).Range
            wr.WholeStory
            Set nws = Sheets.Add
            nws.Name = Left(f.Name, InStrRev(f.Name, ".pdf", -1, vbTextCompare) - 1)
            wr.Copy
            nws.Range("A1").Select
            ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
            cutcopypaste = False
            wa.documents.Close SaveChanges:=wdDoNotSaveChanges
        Next
        wa.Quit
    End If
End Sub

The execute this macro you need to create a sheet Macro with in the cell B3 the folder path of the pdf files.

Regards

Hi Dear ,
This code working perfectly
thank you very much.
I just added another simple macro to prevent word question : "Do you want to keep the last item you copied?"
the code is :

Sub FileClose()
 Dim MyData   As DataObject
Set MyData = New DataObject
MyData.SetText ""
MyData.PutInClipboard
ActiveDocument.Close
End Sub

thank you again

 

[Lokeshbabu]

I have business case. I need to grab texts from certain page. Example : If a PDF has 10 pages, I need to grab only 5,6, and 9 pages to excel. How do I do that?