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]

John, unfortunately I cannot install X2LBB on my current work laptop. Is there another way I can get it to you?

 

[John_w]

Upload the workbook, or better still the PDF, to a file sharing site and post the link here.

 

[cboyce44]

CalCertWithPDFs

 

[cboyce44]

Hopefully that link works. I am using OneDrive

 

[John_w]

It's asking me to sign in.

 

[cboyce44]

Oh. Yeah I would need your email to give you access. I can try something else.

 

[cboyce44]

Try this one. Dropbox

 

[John_w]

OK, I've written a routine to fix the Test Points data by moving the rows 'merged' by the import routine to separate rows:

Private Sub Fix_Sheet(ws As Worksheet)

    Dim findRow As Variant
    Dim r As Long, endCol As Long
    Dim moveCells As Range
    
    With ws
        findRow = Application.Match("Nominal Size", .Columns(1), 0)
        If Not IsError(findRow) Then
            r = findRow + 1
            While Not IsEmpty(.Cells(r, 7).Value)
                endCol = .Cells(r, .Columns.Count).End(xlToLeft).Column
                If endCol > 7 Then
                    Set moveCells = .Cells(r, 7).Resize(, endCol - 6)
                    .Cells(r + 1, 1).EntireRow.Insert
                    moveCells.Cut .Cells(r + 1, 1)
                    .Cells(r, 7).Value = Split(.Cells(r + 1, 1).Value, " ")(0)
                    .Cells(r + 1, 1).Value = Split(.Cells(r + 1, 1).Value, " ")(1)
                End If
                r = r + 1
            Wend
        Else
            MsgBox "'Nominal Size' not found in column A of " & ws.Name, vbCritical
        End If
        
    End With

End Sub

Call Fix_Sheet after the import, like this:

    Set wsSrc = ThisWorkbook.Worksheets("GageBlockData")
    
    Import_PDF_To_Worksheet CStr(userSelectedFile), wsSrc
    
    Fix_Sheet wsSrc

    'Continue with your code ......

    Set wsDest = ThisWorkbook.Worksheets("Nominal Error Calculations")
    Set rngDest = wsDest.Range("A67")

    'etc....

 

[John_w]

Don't use the code I've previously posted because I've just realised that with the Acrobat API we can directly export the PDF to an Excel workbook with just a few lines of code. Then more code can open that workbook and copy it to the "GageBlockData" worksheet. Give me a couple of hours and I should have some new code for you to try.

 

[John_w]

Add this code to a new standard module:

Option Explicit


Public Sub Import_Nominal_Size_Results()

    Dim userSelectedFile As Variant
    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim rngSrc As Range, rngDest As Range
    
    userSelectedFile = Application.GetOpenFilename("PDF Files (*.pdf),*.pdf", 1, "Choose your Gage Block Cert pdf file")

    If userSelectedFile = False Then
        MsgBox "No File selected."
        Exit Sub
    End If
    
    With ThisWorkbook
        Set wsSrc = .Worksheets("GageBlockData")
        Set wsDest = .Worksheets("Nominal Error Calculations")
    End With
    
    Import_PDF_To_Worksheet CStr(userSelectedFile), wsSrc
    
    ' 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
    Set rngDest = wsDest.Range("A67")
    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
    
    wsDest.Activate
    
    MsgBox "Done"

End Sub


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

Call Import_Nominal_Size_Results from your command button like this:

Private Sub CommandButton2_Click()
    Import_Nominal_Size_Results
End Sub