Copying data from multiple pdf files

Question

I have pdf files from which I would like to copy all the data to a column in a spreadsheet.

Here is the code I have. All it does is open the pdf, use control-a, then

Answer 1

I had similar problem. The best solution is, as it was mentioned before, to use Adobe API. In my case it was impossible because macro was intended for 100+ users without Adobe Pro on their PC.

Ultimate solution that I have developed recently was to build converted in C# (for free using Visual Studio and iText library), install it on end users computers and run whenever I need via VBA. Here are some links for more guidance:

1. How to develop pdf converter in C#: link
2. How to create Excel Addin in C#: link
3. How to run C# addin from VBA: link

Overall it's fairly complicated but once done works like a dream.

Another solution as mentioned before is to use sendkeys in VBA. My experience is that it requires some optimization to handle various opening and copying times (depending on file size). Below is code that worked for me, however it's not even near that fast and stable as C# converter.

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'Initialize sleep function via Windows API
Public Sub CopyToSheet(destinationSheet As Worksheet, pathToPdf as String)
'Copy data from PDF to worksheet

    'Initialize timer
    Dim StartTime As Double
    StartTime = Timer

    'Clear clipboard
    Dim myData As DataObject
    Set myData = New DataObject
    myData.SetText text:=Empty
    myData.PutInClipboard
    Set myData = Nothing

    'Build file paths
    Dim pathToAdobe As String
    pathToAdobe = """C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"""
    pathToPdf = """" & pathToPdf & """"

    'Open PDF and wait untill it is open. If file is already opened it will be just activated
    Dim pdfId As Long
    pdfId = Shell(pathToAdobe & " " & pathToPdf, vbMaximizedFocus)
    Do
        Sleep (500)
        If Round(Timer - StartTime, 2) > 9 Then MsgBox "Failed to open PDF": Exit Sub  'Safety check
    Loop Until Me.IsPdfOpen(pathToPdf)

    'Copy and wait until copying is completed
    SendKeys "^a"
    SendKeys "^c"
    Do
        Sleep (500)
        If Round(Timer - StartTime, 2) > 18 Then MsgBox "Failed to copy data to clipboard": Exit Sub  'Safety check
    Loop Until Me.GetClipboardStatus = "ClipboardHasData"

    'Paste data into worksheet
    destinationSheet.Activate
    destinationSheet.Range("A1").Select
    destinationSheet.Paste

    'Close pdf
    Call Shell("TaskKill /F /PID " & CStr(pdfId), vbHide)

    'Clear clipboard
    Set myData = New DataObject
    myData.SetText text:=Empty
    myData.PutInClipboard
    Set myData = Nothing

End Sub

Function IsPdfOpen(pathToPdf) As Boolean
'Check if PDF is already opened

    'Build window name (window name is name of the application on Windows task bar)
    Dim windowName As String
    windowName = pathToPdf
    windowName = Mid(windowName, InStrRev(windowName, "\") + 1, Len(windowName) - InStrRev(windowName, "\") + 1)
    windowName = windowName + " - Adobe Acrobat Reader DC"

    'Try to activate application to check if is opened
    On Error Resume Next
    AppActivate windowName, True
    Select Case Err.Number
        Case 5: IsPdfOpen = False
        Case 0: IsPdfOpen = True
        Case Else: Debug.Assert False
    End Select
    On Error GoTo 0

End Function

Function GetClipboardStatus() As String
'Check if copying data to clipboard is completed

    Dim tempString As String
    Dim myData As DataObject

    'Try to put data from clipboard to string to check if operations on clipboard are completed
    On Error Resume Next
    Set myData = New DataObject
    myData.GetFromClipboard
    tempString = myData.GetText(1)
    If Err.Number = 0 Then
        If tempString = "" Then
            GetClipboardStatus = "ClipboardEmpty"
        Else
            GetClipboardStatus = "ClipboardHasData"
        End If
    Else
        GetClipboardStatus = "ClipboardBusy"
    End If
    On Error GoTo 0

    Set myData = Nothing

End Function