User Select PDF import to specific Excel sheet

[cboyce44]

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

 

[cboyce44]

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):

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

 

[John_w]

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?"

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:

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

 

[cboyce44]

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?

 

[John_w]

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

    ExcelFile = "C:\Temp" & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)

 

[cboyce44]

So I do have a C:\Data folder that is empty. I changed your code to:

 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)

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

 

[cboyce44]

So I do have a C:\Data folder that is empty. I changed your code to:

 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)

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

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

    ExcelFile = "C:\Temp" & Replace(Mid(PDFfile, InStrRev(PDFfile, "\")), ".pdf", ".xlsx", Compare:=vbTextCompare)[/COD
[/QUOTE]

I did this, and it does the same thing.

 

[John_w]

Does the 'Data' environment variable exist? If not:

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

 

[John_w]

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."

pdfPDDoc.GetJSObject.SaveAs ExcelFile, "com.adobe.acrobat." & ext

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.

 

[cboyce44]

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?

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

 

[John_w]

It shows the Sizes of the blocks, but not the final data (See GageBlockDataPasted) in the "Nominal Error Calculations" worksheet.

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.