PDF To Excel

Y

YesImAk

New Member
Joined
May 18, 2022
Messages
11
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
Hello, My name is Piyush and I'm new here and VBA.
So, I wanna convert PDF file to Excel format but everytime I press the macro it just open the PDF file copy what's inside that and paste it in Excel but I'm getting an error at the end (attaching screenshot below).
1652867503661.png


1652867529889.png


Sorry if I'm missing something I'm new in this and I'm editing an old script made by someone else.

VBA Code: 
Sub dd()

Dim sFilePath As String
Dim sFilename As String
Dim ws As Worksheet
Dim sFolder As String
Dim sFilename_1 As String

sFilePath = ThisWorkbook.path
sFilename = Dir(sFilePath & "\*.pdf")

If Len(sFilename) = 0 Then
    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With
sFilename_1 = Dir(sFolder & "\*.pdf")
    If Len(sFilename_1) = 0 Then
    MsgBox "No pdf files are available"
    Exit Sub
    End If

Do While Len(sFilename_1) > 0

Application.DisplayAlerts = False


ActiveWorkbook.FollowHyperlink sFolder & "\" & sFilename_1, NewWindow:=True
Application.DisplayAlerts = True


Application.Wait Now + TimeValue("00:00:1")

Application.SendKeys ("%{V}{P}{DOWN}")
Application.SendKeys ("~")
Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys ("^a")
Application.Wait Now + TimeValue("00:00:1")

Application.SendKeys ("^a")
Application.SendKeys ("^c")
Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys "%{F4}", True
Application.Wait Now + TimeValue("00:00:1")

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Data Fill")
ThisWorkbook.Activate
Sheets("Data Fill").Select
ws.Columns("AC:AC").ClearContents
ws.Range("AC1").Select
ws.Paste
Last_Row = Cells(Rows.Count, 29).End(xlUp).Row

Range("AD1").Select
Range("AD1").Value = "=ADDRESS(2,MATCH(RIGHT(AC4,LEN(AC4)-6),A1:L1,0))"
Range("AD2").Value = "=ADDRESS(MATCH(Q18,AC:AC,0),29)"
Range(Range("AD2").Value & ":AC" & Last_Row).Select
Selection.Cut
Range("AC17").Select
ActiveSheet.Paste
Last_Row = Cells(Rows.Count, 29).End(xlUp).Row
Range("AD3").Value = "=ADDRESS(MATCH(Q59,AC:AC,0),29)"
Range(Range("AD3").Value & ":AC" & Last_Row).Select
Selection.Cut
Range("AC58").Select
ActiveSheet.Paste
Last_Row = Cells(Rows.Count, 29).End(xlUp).Row
ws.Range("AC1:AC" & Last_Row).Select

Selection.Copy
Sheet1.Select
Range(Sheets("Data Fill").Range("AD1").Value).Select
ActiveSheet.Paste
Application.ScreenUpdating = True

sFilename_1 = Dir
Loop
End If


Do While Len(sFilename) > 0

Application.DisplayAlerts = False


ActiveWorkbook.FollowHyperlink sFilename, NewWindow:=True
Application.DisplayAlerts = True


Application.Wait Now + TimeValue("00:00:1")

Application.SendKeys ("%{V}{P}{DOWN}")
Application.SendKeys ("~")

Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys ("^a")
Application.Wait Now + TimeValue("00:00:1")

Application.SendKeys ("^a")
Application.SendKeys ("^c")
Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys "%{F4}", True
Application.Wait Now + TimeValue("00:00:1")

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Data Fill")
ThisWorkbook.Activate
Sheets("Data Fill").Select
ws.Range("AC1:AC500").ClearContents
ws.Range("AD1:AD3").ClearContents
Range("AC1").Select
ws.Paste
Last_Row = Cells(Rows.Count, 29).End(xlUp).Row

Range("AD1").Select
Range("AD1").Value = "=ADDRESS(2,MATCH(RIGHT(AC4,LEN(AC4)-6),A1:L1,0))"
Range("AD2").Value = "=ADDRESS(MATCH(Q18,AC:AC,0),29)"
Range(Range("AD2").Value & ":AC" & Last_Row).Select
Selection.Cut
Range("AC17").Select
ws.Paste
Last_Row = Cells(Rows.Count, 29).End(xlUp).Row
Range("AD3").Value = "=ADDRESS(MATCH(Q59,AC:AC,0),29)"
Range(Range("AD3").Value & ":AC" & Last_Row).Select
Selection.Cut
Range("AC58").Select
ws.Paste
Last_Row = Cells(Rows.Count, 29).End(xlUp).Row
ws.Range("AC1:AC" & Last_Row).Select

Selection.Copy
Sheet1.Select
Range(Sheets("Data Fill").Range("AD1").Value).Select
ActiveSheet.Paste
Application.ScreenUpdating = True
sFilename = Dir
Loop
Sheet1.Select
Range("Q12:Q17").Select
    Selection.Copy
    Range("A12:K17").Select
    ActiveSheet.Paste
    Range("Q53:Q58").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A53:K58").Select
    ActiveSheet.Paste
Range("A77:L200").ClearContents
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Try this:-
VBA Code: 
Sub PDFActiveXlsxSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
 
Last edited by a moderator:
Upvote 0
sleek12 said:
Try this:-
VBA Code: 
Sub PDFActiveXlsxSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
Click to expand...
It worked but not the way I expected, Anyways thank you so much I appreciate your help.
 
Upvote 0
If you are looking to save time, then use Power Query
On the data tab, select Get and Transform, Get Data-->From file==>From PDF then on the PQ Editor Ribbon click on Close and Load
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
User Select PDF import to specific Excel sheet
2 3 4
Replies
31
Views
1K
John_w
J
N
  • Solved
Pasting Value with VBA - Sorta Looping based on a multiple of 30
Replies
2
Views
401
nmbc99
N
W
  • Question Question
how to make this less in proper code
2
Replies
11
Views
864
Anthony47
A
A
  • Question Question
Is there a way to speed this up?
Replies
4
Views
316
jolivanes
jolivanes
S
  • Question Question
Vba IE work in background( very urgent)
Replies
0
Views
791
Sunil7598
S

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,624
Latest member
gregg777

Share this page

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
Back
Top