PDF Copy and Paste – fails on Paste

rex759

Well-known Member
Joined
Nov 8, 2004
Messages
608
Office Version
  1. 365
Platform
  1. Windows
Hello,
I got this code from this forum to copy and paste a PDF into an Excel. Works perfectly on older versions of Windows so not sure why its not working on Windows 10. I am using Adobe Reader.
The code halts on this line:

Run time error 1004 – Microsoft Excel cannot paste the data

WKS.Paste

If I press F8 to continue, the data pastes correctly.

I have tried to change the focus using Appactivate for Excel and for the Adobe and neither worked. Also tried to Pastespecial and still receive the same results, halting on the paste line.

Here is where I got the original code:
Example Copy All Text in PDF

There are about 5 different modules with API calls, Clear Clipboard etc... I only included the part giving me the headache. Any help is appreciated

VBA Code:
Public Sub CopyPDFText()

  ' Written:  February 19, 2018
  ' Author:   Leith Ross

    Dim Cell    As Range
    Dim col     As Long
    Dim hwnd    As Long
    Dim retval  As Long
    Dim Wks     As Worksheet
    
    Const HWND_TOPMOST      As Long = -1
    Const HWND_TOP          As Long = 0
    Const SWP_NOSIZE        As Long = &H1
    Const SWP_NOMOVE        As Long = &H2
    Const SWP_SHOWWINDOW    As Long = &H40
    
    Const SW_HIDE = 0
    Const SW_NORMAL = 1
    Const SW_MAXIMIZE = 3
    Const SW_MINIMIZE = 6
    Const SW_RESTORE = 9
        
        If CountClipboardFormats <> 0 Then Call ClearClipboard
        
        Set Wks = ThisWorkbook.ActiveSheet
        
        Set Cell = Wks.Cells.Find("*", Wks.Cells(1, Columns.Count), xlValues, xlWhole, xlByColumns, xlPrevious, False, False, False)
            If Cell Is Nothing Then col = 1 Else col = Cell.Column
        
        Set Cell = Wks.Cells(1, col + 1)
        
        hwnd = FindWindow("AcrobatSDIWindow", vbNullString)
            If hwnd = 0 Then
                MsgBox "There are No Open PDF Files.", vbExclamation
                Exit Sub
            End If
        
       'Set the window position to be on top of all other windows.
        retval = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE)
        
       'Display the PDF window.
        retval = ShowWindow(hwnd, SW_RESTORE)
        
        'Select All Text
        Call CopyAll
        
        'Wait unitl PDF has finished copying.
        While CountClipboardFormats = 0: DoEvents: Wend
        
        'Send the PDF window to the Task Bar
        retval = ShowWindow(hwnd, SW_MINIMIZE)
        
        Wks.Paste
        Cell.Select
        
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Forum statistics

Threads
1,214,908
Messages
6,122,187
Members
449,071
Latest member
cdnMech

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