User Select PDF import to specific Excel sheet

C

cboyce44

New Member
Joined
Oct 3, 2023
Messages
42
Office Version
  1. 365
Platform
  1. Windows
I have an issue. My company moved to Windows 11, and Excel changed a few things to the point where the original code no longer works. I'm wondering if someone can help me. It's getting stuck when it opens up the user selected pdf file (See bold in code below). I currently have it where after the operator selects the pdf document, the pdf document opens. Then I send the keys to PDF document to open up under Main Menu "File", then select "Export a Pdf", then select Microsoft Excel, finally select "Microsoft Excel Workbook". When this happened the newly opened Workbook used to have the extension "(userSelectedFile.pdf).xlsx" after it. Now the current way Excel opens a new Workbook using the method I have, it just has the "(userSelectedFile).xlsx". It is missing the .pdf. I don't know how to make it so when the User selects the .pdf file, the program can see the newly opened Workbook with just the Name of the file they selected and the .xlsx after it? I tried using "*.xlsx" but it errors out. I'm hoping someone can help me out.

Here is the current code I'm trying to use. If you know of a MUCH easier way to import PDF file, then please let me know. I'm a beginner at all of this, and have just self taught myself what little I know.

Private Sub CommandButton2_Click()

Dim userSelectedFile As Variant
Dim windowTitle As String
Dim fileFilter As String
Dim fileFilterIndex As Integer
Dim OpenBook As Workbook
Application.ScreenUpdating = False
windowTitle = "Choose your Gage Block Cert pdf file"

fileFilter = "PDF Files (*.pdf),*.pdf" 'Allows user to select pdf files only
'fileFilter = "PDF or Text Files (*.pdf;*.txt),*.pdf;*.txt" 'Allows user to select pdf or text files

fileFilterIndex = 1 ' For fileFilter to allow user to select pdf files only
'fileFilterIndex = 2 ' For fileFilter to allow user to select pdf or text files

userSelectedFile = Application.GetOpenFilename(fileFilter, fileFilterIndex, windowTitle)

If userSelectedFile = False Then
MsgBox "No File selected."
Exit Sub
Else
MsgBox "File selected: " & userSelectedFile
ThisWorkbook.FollowHyperlink (userSelectedFile)
End If

'Sends Commands in Adobe to create data from pdf file
Application.SendKeys "%{f}", True
Application.SendKeys "d", True
Application.SendKeys "x", True
Application.SendKeys "e", True
Application.SendKeys userSelectedFile, True
Application.SendKeys "^{ENTER}", True
Application.SendKeys "y", True
Application.Wait Now + 0.00005
Application.SendKeys "{numlock}%s", True
Application.Wait Now + 0.0001

'Opens Workbook that is created. Copies and pastes data into GageBlockData tab
Set OpenBook = Application.Workbooks.Open(userSelectedFile & ".xlsx")
OpenBook.Sheets(1).Range("A1:P100").Copy

ThisWorkbook.Worksheets("GageBlockData").Range("A1").PasteSpecial xlPasteValues


Dim wsSrc As Worksheet, wsDest As Worksheet
Dim rngSrc As Range, rngDest As Range, rCell As Range
Dim rowSrc As Long
Dim colLast As Long
Dim cntItem As Long
Dim arrDest As Variant
Dim i As Long

Set wsSrc = GageBSh ' If you know the sheet name use - Worksheets("Sheet_Name")
Set wsDest = ThisWorkbook.Worksheets("Nominal Error Calculations")
Set rngDest = wsDest.Range("A67")

' Look for Nominal Size
Set rngSrc = wsSrc.UsedRange.Find(What:="Nominal Size", LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If rngSrc Is Nothing Then Exit Sub

' Data range is a fixed size
rngDest.Offset(0).Resize(25).Value = rngSrc.Offset(0).Resize(25).Value
rngDest.Offset(0, 1).Resize(25).Value = rngSrc.Offset(0, 9).Resize(25).Value


Set pApp = CreateObject("AcroExch.App")
pApp.GetActiveDoc.Close True
Set pApp = Nothing

CutCopyMode = False

Application.CutCopyMode = False

Application.ScreenUpdating = True




End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
cboyce44 said:
If you know of a MUCH easier way to import PDF file, then please let me know.
Click to expand...

VBA can open the PDF in Word and copy and paste it to the Excel worksheet.

First add this procedure below your code:

VBA Code: 
Private Sub Import_PDF_To_Worksheet(PDFinputFile As String, destWorksheet As Worksheet)

    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WshShell As Object
    Dim registryName As String, registryValue As String
    
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err Then
        Set WordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    
    Set WshShell = CreateObject("WScript.Shell")
    
    registryName = "HKCU\SOFTWARE\Microsoft\Office\" & WordApp.Version & "\Word\Options\DisableConvertPdfWarning"
    
    'Save the current "DisableConvertPdfWarning" registry value and change it to disable Word's convert PDF warning
    
    On Error Resume Next
    registryValue = WshShell.RegRead(registryName)
    On Error GoTo 0
    WshShell.RegWrite registryName, 1, "REG_DWORD"
    
    'Open the PDF file in Word and copy and paste the contents to the specified worksheet
    
    Set WordDoc = WordApp.Documents.Open(Filename:=PDFinputFile, ConfirmConversions:=False)
    WordDoc.Content.Copy
    With destWorksheet
        .Range("A1").Select
        .PasteSpecial Format:="Text"
    End With
    WordDoc.Close SaveChanges:=False
    
    WordApp.Quit SaveChanges:=False
    
    'Restore "DisableConvertPdfWarning" registry value
    
    If registryValue = vbNullString Then
        WshShell.RegWrite registryName, 0, "REG_DWORD"
    Else
        WshShell.RegWrite registryName, CLng(registryValue), "REG_DWORD"
    End If
    
    Set WordApp = Nothing
    Set WshShell = Nothing

End Sub

Call the procedure from your code thus:

VBA Code: 
    Import_PDF_To_Worksheet CStr(userSelectedFile), ThisWorkbook.Worksheets("GageBlockData")
which replaces all your code between 'Sends Commands in Adobe to create data from pdf file and ThisWorkbook.Worksheets("GageBlockData").Range("A1").PasteSpecial xlPasteValues inclusive. Delete ThisWorkbook.FollowHyperlink (userSelectedFile).

Also, Set wsSrc = GageBSh should be Set wsSrc = ThisWorkbook.Worksheets("GageBlockData").
 
Upvote 0
Hi John. Thanks for your help. I did what you told (at least I think I did), and I get a "Run-Time error '1004': Application-defined or object-defined error". Here is what I did with the code:

Private Sub CommandButton2_Click()

Dim userSelectedFile As Variant
Dim windowTitle As String
Dim fileFilter As String
Dim fileFilterIndex As Integer
Dim OpenBook As Workbook
Application.ScreenUpdating = False
windowTitle = "Choose your Gage Block Cert pdf file"

fileFilter = "PDF Files (*.pdf),*.pdf" 'Allows user to select pdf files only
'fileFilter = "PDF or Text Files (*.pdf;*.txt),*.pdf;*.txt" 'Allows user to select pdf or text files

fileFilterIndex = 1 ' For fileFilter to allow user to select pdf files only
'fileFilterIndex = 2 ' For fileFilter to allow user to select pdf or text files

userSelectedFile = Application.GetOpenFilename(fileFilter, fileFilterIndex, windowTitle)

If userSelectedFile = False Then
MsgBox "No File selected."
Exit Sub
Else
MsgBox "File selected: " & userSelectedFile
End If

Import_PDF_To_Worksheet CStr(userSelectedFile), ThisWorkbook.Worksheets("GageBlockData")


Dim wsSrc As Worksheet, wsDest As Worksheet
Dim rngSrc As Range, rngDest As Range, rCell As Range
Dim rowSrc As Long
Dim colLast As Long
Dim cntItem As Long
Dim arrDest As Variant
Dim i As Long

Set wsSrc = ThisWorkbook.Worksheets("GageBlockData") ' If you know the sheet name use - Worksheets("Sheet_Name")
Set wsDest = ThisWorkbook.Worksheets("Nominal Error Calculations")
Set rngDest = wsDest.Range("A67")

' Look for Nominal Size
Set rngSrc = wsSrc.UsedRange.Find(What:="Nominal Size", LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If rngSrc Is Nothing Then Exit Sub

' Data range is a fixed size
rngDest.Offset(0).Resize(25).Value = rngSrc.Offset(0).Resize(25).Value
rngDest.Offset(0, 1).Resize(25).Value = rngSrc.Offset(0, 9).Resize(25).Value


Set pApp = CreateObject("AcroExch.App")
pApp.GetActiveDoc.Close True
Set pApp = Nothing

CutCopyMode = False

Application.CutCopyMode = False

Application.ScreenUpdating = True


End Sub

At the bottom of the the code (I have multiple codes after this one) I put yours:

Private Sub Import_PDF_To_Worksheet(PDFinputFile As String, destWorksheet As Worksheet)

Dim WordApp As Object
Dim WordDoc As Object
Dim WshShell As Object
Dim registryName As String, registryValue As String

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set WshShell = CreateObject("WScript.Shell")

registryName = "HKCU\SOFTWARE\Microsoft\Office\" & WordApp.Version & "\Word\Options\DisableConvertPdfWarning"

'Save the current "DisableConvertPdfWarning" registry value and change it to disable Word's convert PDF warning

On Error Resume Next
registryValue = WshShell.RegRead(registryName)
On Error GoTo 0
WshShell.RegWrite registryName, 1, "REG_DWORD"

'Open the PDF file in Word and copy and paste the contents to the specified worksheet

Set WordDoc = WordApp.Documents.Open(Filename:=PDFinputFile, ConfirmConversions:=False)
WordDoc.Content.Copy
With destWorksheet
.Range("A1").Select
.PasteSpecial Format:="Text"
End With
WordDoc.Close SaveChanges:=False

WordApp.Quit SaveChanges:=False

'Restore "DisableConvertPdfWarning" registry value

If registryValue = vbNullString Then
WshShell.RegWrite registryName, 0, "REG_DWORD"
Else
WshShell.RegWrite registryName, CLng(registryValue), "REG_DWORD"
End If

Set WordApp = Nothing
Set WshShell = Nothing

End Sub


Is there something I did wrong?
 
Upvote 0
It looks like you've applied my changes correctly, though it's hard to see because the code isn't posted between VBA code tags.

cboyce44 said:
I get a "Run-Time error '1004': Application-defined or object-defined error".
Click to expand...

Where does that error occur? Click Debug on the error message and the errant line is highlighted in yellow.
 
Upvote 0
It looks like it is coming up right at the "Import_PDF_To_Worksheet CStr(userSelectedFile), ThisWorkbook.Worksheets("GageBlockData") line. See image attached. I also moved your code to just below it. however, it put it under (General). Could this be the issue?


Drop down 1 shows "CommandButton2" Drop down 2 shows "Click"

Private Sub CommandButton2_Click()

Dim userSelectedFile As Variant
Dim windowTitle As String
Dim fileFilter As String
Dim fileFilterIndex As Integer
Dim OpenBook As Workbook
Application.ScreenUpdating = False

windowTitle = "Choose your Gage Block Cert pdf file"

fileFilter = "PDF Files (*.pdf),*.pdf" 'Allows user to select pdf files only
'fileFilter = "PDF or Text Files (*.pdf;*.txt),*.pdf;*.txt" 'Allows user to select pdf or text files

fileFilterIndex = 1 ' For fileFilter to allow user to select pdf files only
'fileFilterIndex = 2 ' For fileFilter to allow user to select pdf or text files

userSelectedFile = Application.GetOpenFilename(fileFilter, fileFilterIndex, windowTitle)

If userSelectedFile = False Then
MsgBox "No File selected."
Exit Sub
Else
MsgBox "File selected: " & userSelectedFile
End If

Import_PDF_To_Worksheet CStr(userSelectedFile), ThisWorkbook.Worksheets("GageBlockData")

Dim wsSrc As Worksheet, wsDest As Worksheet
Dim rngSrc As Range, rngDest As Range, rCell As Range
Dim rowSrc As Long
Dim colLast As Long
Dim cntItem As Long
Dim arrDest As Variant
Dim i As Long

Set wsSrc = ThisWorkbook.Worksheets("GageBlockData") ' If you know the sheet name use - Worksheets("Sheet_Name")
Set wsDest = ThisWorkbook.Worksheets("Nominal Error Calculations")
Set rngDest = wsDest.Range("A67")

' Look for Nominal Size
Set rngSrc = wsSrc.UsedRange.Find(What:="Nominal Size", LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If rngSrc Is Nothing Then Exit Sub

' Data range is a fixed size
rngDest.Offset(0).Resize(25).Value = rngSrc.Offset(0).Resize(25).Value
rngDest.Offset(0, 1).Resize(25).Value = rngSrc.Offset(0, 9).Resize(25).Value


Set pApp = CreateObject("AcroExch.App")
pApp.GetActiveDoc.Close True
Set pApp = Nothing

CutCopyMode = False

Application.CutCopyMode = False

Application.ScreenUpdating = True


End Sub

____________________________________________________________________________________________________________________________________

Drop down 1 shows "General" Drop down 2 shows "Import_PDF_To_Worksheet"

Private Sub Import_PDF_To_Worksheet(PDFinputFile As String, destWorksheet As Worksheet)

Dim WordApp As Object
Dim WordDoc As Object
Dim WshShell As Object
Dim registryName As String, registryValue As String

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set WshShell = CreateObject("WScript.Shell")

registryName = "HKCU\SOFTWARE\Microsoft\Office\" & WordApp.Version & "\Word\Options\DisableConvertPdfWarning"

'Save the current "DisableConvertPdfWarning" registry value and change it to disable Word's convert PDF warning

On Error Resume Next
registryValue = WshShell.RegRead(registryName)
On Error GoTo 0
WshShell.RegWrite registryName, 1, "REG_DWORD"

'Open the PDF file in Word and copy and paste the contents to the specified worksheet

Set WordDoc = WordApp.Documents.Open(Filename:=PDFinputFile, ConfirmConversions:=False)
WordDoc.Content.Copy
With destWorksheet
.Range("A1").Select
.PasteSpecial Format:="Text"
End With
WordDoc.Close SaveChanges:=False

WordApp.Quit SaveChanges:=False

'Restore "DisableConvertPdfWarning" registry value

If registryValue = vbNullString Then
WshShell.RegWrite registryName, 0, "REG_DWORD"
Else
WshShell.RegWrite registryName, CLng(registryValue), "REG_DWORD"
End If

Set WordApp = Nothing
Set WshShell = Nothing


End Sub
 

Attachments

  • VBA Error.jpg
    VBA Error.jpg
    119.7 KB · Views: 9
Upvote 0
cboyce44 said:
I also moved your code to just below it. however, it put it under (General). Could this be the issue?
Click to expand...

No, that just means it's a normal procedure rather than an object which can receive events, like the command button and sheet.

Can you step into Import_PDF_To_Worksheet? When the error occurs click Debug and press F8 and keep pressing F8 until the error occurs.

PS - please post VBA code inside VBA code tags (click the VBA icon on the message editor toolbar), like this:

[CODE=vba]
Paste your code here
[/CODE]
 
Last edited:
Upvote 0
VBA Code: 
Private Sub CommandButton2_Click()

    Dim userSelectedFile As Variant
    Dim windowTitle As String
    Dim fileFilter As String
    Dim fileFilterIndex As Integer
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False

    windowTitle = "Choose your Gage Block Cert pdf file"

    fileFilter = "PDF Files (*.pdf),*.pdf" 'Allows user to select pdf files only
    'fileFilter = "PDF or Text Files (*.pdf;*.txt),*.pdf;*.txt" 'Allows user to select pdf or text files

    fileFilterIndex = 1 ' For fileFilter to allow user to select pdf files only
    'fileFilterIndex = 2 ' For fileFilter to allow user to select pdf or text files

    userSelectedFile = Application.GetOpenFilename(fileFilter, fileFilterIndex, windowTitle)

        If userSelectedFile = False Then
        MsgBox "No File selected."
        Exit Sub
    Else
        MsgBox "File selected: " & userSelectedFile
    End If

    Import_PDF_To_Worksheet CStr(userSelectedFile), ThisWorkbook.Worksheets("GageBlockData")

    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim rngSrc As Range, rngDest As Range, rCell As Range
    Dim rowSrc As Long
    Dim colLast As Long
    Dim cntItem As Long
    Dim arrDest As Variant
    Dim i As Long

    Set wsSrc = ThisWorkbook.Worksheets("GageBlockData") ' If you know the sheet name use - Worksheets("Sheet_Name")
    Set wsDest = ThisWorkbook.Worksheets("Nominal Error Calculations")
    Set rngDest = wsDest.Range("A67")

    ' Look for Nominal Size
    Set rngSrc = wsSrc.UsedRange.Find(What:="Nominal Size", LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    If rngSrc Is Nothing Then Exit Sub

    ' Data range is a fixed size
    rngDest.Offset(0).Resize(25).Value = rngSrc.Offset(0).Resize(25).Value
    rngDest.Offset(0, 1).Resize(25).Value = rngSrc.Offset(0, 9).Resize(25).Value

    Set pApp = CreateObject("AcroExch.App")
        pApp.GetActiveDoc.Close True
    Set pApp = Nothing

    CutCopyMode = False

    Application.CutCopyMode = False

    Application.ScreenUpdating = True


End Sub
Private Sub Import_PDF_To_Worksheet(PDFinputFile As String, destWorksheet As Worksheet)

    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WshShell As Object
    Dim registryName As String, registryValue As String

    On Error Resume Next
        Set WordApp = GetObject(, "Word.Application")
            If Err Then
                Set WordApp = CreateObject("Word.Application")
            End If
    On Error GoTo 0

    Set WshShell = CreateObject("WScript.Shell")

    registryName = "HKCU\SOFTWARE\Microsoft\Office\" & WordApp.Version & "\Word\Options\DisableConvertPdfWarning"

    'Save the current "DisableConvertPdfWarning" registry value and change it to disable Word's convert PDF warning

    On Error Resume Next
        registryValue = WshShell.RegRead(registryName)
    On Error GoTo 0
        WshShell.RegWrite registryName, 1, "REG_DWORD"

    'Open the PDF file in Word and copy and paste the contents to the specified worksheet

    Set WordDoc = WordApp.Documents.Open(Filename:=PDFinputFile, ConfirmConversions:=False)
    WordDoc.Content.Copy
        With destWorksheet
            .Range("A1").Select
            .PasteSpecial Format:="Text"
        End With
    WordDoc.Close SaveChanges:=False

    WordApp.Quit SaveChanges:=False

    'Restore "DisableConvertPdfWarning" registry value

    If registryValue = vbNullString Then
        WshShell.RegWrite registryName, 0, "REG_DWORD"
            Else
        WshShell.RegWrite registryName, CLng(registryValue), "REG_DWORD"
    End If

    Set WordApp = Nothing
    Set WshShell = Nothing


End Sub

When I walk through the lines one by one. It goes down into the Import_PDF_To_Worksheet. It last highlights ".Range("A1").Select in this part of the code:

VBA Code: 
 'Open the PDF file in Word and copy and paste the contents to the specified worksheet

    Set WordDoc = WordApp.Documents.Open(Filename:=PDFinputFile, ConfirmConversions:=False)
    WordDoc.Content.Copy
        With destWorksheet
            .Range("A1").Select
            .PasteSpecial Format:="Text"
        End With
    WordDoc.Close SaveChanges:=False

    WordApp.Quit SaveChanges:=False
 
Upvote 0
John_w said:
Add line .Activate after With destWorksheet.
Click to expand...
Looks like it worked importing it. Just looks like now it is having issues with sorting the info after it has been imported. It's not nearly as orderly as it was when it imported before. lol Thus it errors out again. I've attached a picture as to what the typical pdf the operator would select. I'm trying to get the Final results for all of the Nominal Sizes. When I imported it the original way, it would look pretty much like that in the excel sheet I imported it to. (See Original Pic) Now it looks like this (See New Pic) How can I get it to import more organized?
 

Attachments

  • SamplePDF.jpg
    SamplePDF.jpg
    165.3 KB · Views: 9
  • Original Pic.jpg
    Original Pic.jpg
    219.4 KB · Views: 10
  • New Pic.jpg
    New Pic.jpg
    234.2 KB · Views: 10
Upvote 0
cboyce44 said:
How can I get it to import more organized?
Click to expand...

The result you see is Word converting the PDF to a document and copying/pasting it to Excel and I don't think there any Word settings/options which affect the conversion. Word's conversion is obviously not as good as Adobe's Export to Excel.

It looks like the incorrectly imported data rows are those containing "um n.nn", e.g. "um 1.08" in the 7th data column. To tidy the import you would need code which looks in column G and if the text is not "um", move the following 7 data columns to a newly inserted row for each "um n.nn". If you post the New Pic sheet using the XL2BB Mini Sheet feature then I'll try to write the code to tidy the imported data.

In your code:
VBA Code: 
Set pApp = CreateObject("AcroExch.App")
indicates you have Acrobat Professional installed. In that case the Acrobat API can be called from VBA to read the PDF 'string by string' and write to Excel cells. As a separate test, open the PDF in Adobe/Acrobat, select all and copy/paste to Excel. The result is typically the same as using the Acrobat API method.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA to search for table from PDF File and copy and paste to Worksheet
Replies
5
Views
1K
cboyce44
C
M
  • Question Question
Data Transfer from Excel to PowerPoint and getting PDF file of PPT
Replies
1
Views
126
Sequoyah
Sequoyah
T
  • Question Question
Printing to PDF use VBA - Was working but now different sheets are different widths
Replies
1
Views
307
Tanquen
T
S
  • Question Question
Saving an Excel Range as Word and PDF document
Replies
5
Views
542
Trevor G
Trevor G
I
  • Question Question
Find customer in column & link to his pdf
2
Replies
16
Views
654
NoSparks
N

Forum statistics

Threads
1,224,809
Messages
6,181,075
Members
453,020
Latest member
mattg2448

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