User Select PDF import to specific Excel sheet

C

cboyce44

New Member
Joined
Oct 3, 2023
Messages
39
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
 
Sort by date Sort by votes
So it looks like when I select the pdf, it runs through but then I get an error "Run-time error '1004': Sorry, we couldn't find C:\Users\u7cboyce\OneDrive - Carl Zeiss AG\Desktop\Tech Support\New Certs\CalCertWithPDFs\Gageblocks_workbook.xlsx. Is it possible it was moved, renamed or deleted?"

When I select the "Debug" button, it shows it on this line of the code (Made it bold):

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

    Dim pdfPDDoc As Object
    Dim ExcelFile As String, ext As String
    Dim inputWb As Workbook
    
    ExcelFile = Replace(PDFfile, ".pdf", "_workbook.xlsx", Compare:=vbTextCompare)
    
    ext = Mid(ExcelFile, InStrRev(ExcelFile, ".") + 1)
    
    Set pdfPDDoc = CreateObject("AcroExch.PDDoc")
    
    If pdfPDDoc.Open(PDFfile) Then
    
        pdfPDDoc.GetJSObject.SaveAs ExcelFile, "com.adobe.acrobat." & ext
        pdfPDDoc.Close
        
        Application.ScreenUpdating = False
        destWorksheet.Cells.Clear
        [B]Set inputWb = Workbooks.Open(ExcelFile, ReadOnly:=True)[/B]
        inputWb.Worksheets(1).Cells.Copy destWorksheet.Range("A1")
        inputWb.Close False
        Application.ScreenUpdating = True
        
        Kill ExcelFile
        
    End If
  
End Sub
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
cboyce44 said:
but then I get an error "Run-time error '1004': Sorry, we couldn't find C:\Users\u7cboyce\OneDrive - Carl Zeiss AG\Desktop\Tech Support\New Certs\CalCertWithPDFs\Gageblocks_workbook.xlsx. Is it possible it was moved, renamed or deleted?"
Click to expand...

Might be because the code doesn't have write access to the OneDrive folder, therefore the exported workbook isn't created and so it doesn't exist.

Replace the ExcelFile = line with this so that the exported workbook is created in your temp folder:

VBA Code: 
    ExcelFile = Environ("temp") & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)
 
Upvote 0
Does the same thing with the temp file location. Is there a setting I have to change in Excel to be able to write to it?
 
Upvote 0
No, it's the Windows permissions on the folder. Assuming C:\Temp\ exists, try:

VBA Code: 
    ExcelFile = "C:\Temp" & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)
 
Upvote 0
So I do have a C:\Data folder that is empty. I changed your code to:

VBA Code: 
 ExcelFile = Environ("Data") & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)

Now it passes that, but comes up with this error now "Run-Time error '1001': NotAllowedError: Security settings prevent access to this property or method."

I click "debug", and now it's highlighting this line in the code: (I put it in bold)

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

    Dim pdfPDDoc As Object
    Dim ExcelFile As String, ext As String
    Dim inputWb As Workbook
    
    ExcelFile = Environ("Data") & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)
    
    ext = Mid(ExcelFile, InStrRev(ExcelFile, ".") + 1)
    
    Set pdfPDDoc = CreateObject("AcroExch.PDDoc")
    
    If pdfPDDoc.Open(PDFfile) Then
    
        [B]pdfPDDoc.GetJSObject.SaveAs ExcelFile, "com.adobe.acrobat." & ext[/B]
        pdfPDDoc.Close
        
        Application.ScreenUpdating = False
        destWorksheet.Cells.Clear
        Set inputWb = Workbooks.Open(ExcelFile, ReadOnly:=True)
        inputWb.Worksheets(1).Cells.Copy destWorksheet.Range("A1")
        inputWb.Close False
        Application.ScreenUpdating = True
        
        Kill ExcelFile
        
    End If
  
End Sub
 
Upvote 0
cboyce44 said:
So I do have a C:\Data folder that is empty. I changed your code to:

VBA Code: 
 ExcelFile = Environ("Data") & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)

Now it passes that, but comes up with this error now "Run-Time error '1001': NotAllowedError: Security settings prevent access to this property or method."

I click "debug", and now it's highlighting this line in the code: (I put it in bold)

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

    Dim pdfPDDoc As Object
    Dim ExcelFile As String, ext As String
    Dim inputWb As Workbook
 
    ExcelFile = Environ("Data") & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)
 
    ext = Mid(ExcelFile, InStrRev(ExcelFile, ".") + 1)
 
    Set pdfPDDoc = CreateObject("AcroExch.PDDoc")
 
    If pdfPDDoc.Open(PDFfile) Then
 
        [B]pdfPDDoc.GetJSObject.SaveAs ExcelFile, "com.adobe.acrobat." & ext[/B]
        pdfPDDoc.Close
     
        Application.ScreenUpdating = False
        destWorksheet.Cells.Clear
        Set inputWb = Workbooks.Open(ExcelFile, ReadOnly:=True)
        inputWb.Worksheets(1).Cells.Copy destWorksheet.Range("A1")
        inputWb.Close False
        Application.ScreenUpdating = True
     
        Kill ExcelFile
     
    End If
 
End Sub
Click to expand...

John_w said:
No, it's the Windows permissions on the folder. Assuming C:\Temp\ exists, try:

VBA Code: 
    ExcelFile = "C:\Temp" & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)[/COD
[/QUOTE]
Click to expand...
I did this, and it does the same thing.
 
Upvote 0
Does the 'Data' environment variable exist? If not:

VBA Code: 
    ExcelFile = "C:\Data" & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)
 
Upvote 0
cboyce44 said:
Now it passes that, but comes up with this error now "Run-Time error '1001': NotAllowedError: Security settings prevent access to this property or method."
Click to expand...

cboyce44 said:
pdfPDDoc.GetJSObject.SaveAs ExcelFile, "com.adobe.acrobat." & ext
Click to expand...

See https://answers.acrobatusers.com/No...gs-prevent-access-property-method-q33221.aspx

The solution is to use an Acrobat trusted function, but I've no idea how to implement one in the context of an Acrobat object called from a VBA process, or whether it would even work.

If you can't get the Acrobat API code to work then you'll have to revert to my first idea in posts 2, 8 and 18.
 
Upvote 0
Okay. It works great now where it copy and pastes the data neatly in the "GageBlockData" worksheet. However, now when it looks for the "Nominal Size" to get the data I specifically need from the GageBlockData sheet (See pic GageBlockDataNeeded), it doesn't paste it all. It shows the Sizes of the blocks, but not the final data (See GageBlockDataPasted) in the "Nominal Error Calculations" worksheet. I think this has to do with the code highlighted?

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")
    
    Import_PDF_To_Worksheet CStr(userSelectedFile), wsSrc
    
    Fix_Sheet wsSrc
    
    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
   [B] 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[/B]
    
    Set pApp = Nothing

    CutCopyMode = False

    Application.CutCopyMode = False

    Application.ScreenUpdating = True


End Sub
 

Attachments

  • GageBlockDataNeeded.jpg
    GageBlockDataNeeded.jpg
    175 KB · Views: 7
  • GageBlockDataPasted.jpg
    GageBlockDataPasted.jpg
    114.4 KB · Views: 7
Upvote 0
cboyce44 said:
It shows the Sizes of the blocks, but not the final data (See GageBlockDataPasted) in the "Nominal Error Calculations" worksheet.
Click to expand...

Your Acrobat 'export' produced empty columns in the worksheet, hence the Offset(0, 9) which addresses the 'Final' column.

The Word 'export' doesn't have the empty columns, so change it to Offset(0, 5) to read the 'Final' column.
 
Upvote 0
Solution
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
T
  • Question Question
Printing to PDF use VBA - Was working but now different sheets are different widths
Replies
1
Views
190
Tanquen
T
S
  • Question Question
Saving an Excel Range as Word and PDF document
Replies
5
Views
450
Trevor G
Trevor G
I
  • Question Question
Find customer in column & link to his pdf
2
Replies
16
Views
603
NoSparks
N
N
  • Solved
Pasting Value with VBA - Sorta Looping based on a multiple of 30
Replies
2
Views
393
nmbc99
N

Forum statistics

Threads
1,223,754
Messages
6,174,311
Members
452,554
Latest member
Louis1225

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