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

Omarom

New Member
Joined
Oct 21, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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]
Rich (BB 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
 

Attachments

  • 1.JPG
    1.JPG
    21.2 KB · Views: 5
  • 2.JPG
    2.JPG
    42.7 KB · Views: 4

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Rino702

New Member
Joined
Mar 16, 2015
Messages
22
Hello Omaron,

Here the code macro adapted for your needs.

VBA Code:
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
 
Solution

Omarom

New Member
Joined
Oct 21, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hello Omaron,

Here the code macro adapted for your needs.

VBA Code:
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 :
VBA Code:
Sub FileClose()
 Dim MyData   As DataObject
Set MyData = New DataObject
MyData.SetText ""
MyData.PutInClipboard
ActiveDocument.Close
End Sub

thank you again :)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,874
Messages
5,638,781
Members
417,052
Latest member
Noobest

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