Paste from clipboard in loop using VBA

[fruWasbo]

I am working on a Project where the task is to populate a list of pdf-files (in sheet "Get files") and then open each pdf-file, copy all text and paste this text into a column of another Excel sheet ("ExtractedText")

Everything Works fine except for the final step of pasting it from clipboard.
I've tried different solutions and terminology for .PasteSpecial or SendKeys("^v")

The Sendkeys solution Works only for the latter file. I Guess this has to do With the speed of it and the program can't manage to paste before another file is opened and the clipboard is replaced. Increasing the wait does not seem to do the trick.

The PasteSpecial solution throws an error that the 'PasteSpecial Method of Range class failed'. The range is only one cell and the content of the clipboard is larger, but it seems that hardcoding the size of it for testing does not help.

Any solution to fix one of my solutions?


Here's the code (With the sendkeys solution inactivated):

Sub ReadListedFiles()
    Dim AdobeApp As String, adr As String
    Dim StartAdobe
    Dim starAppCap As String
    Dim rng As Range
    Dim fn As String
    
    Set rng = Sheets("Get Files").Range("A1:A1000")
    
    strAppCap = Application.Caption
    
    Sheets("ExtractedText").Rows.ClearContents
    
    cc = 1
    i = 9
    For Each cell In rng
        fn = Sheets("Get Files").Cells(i, 2).Value
        If fn <> "" Then
            AdobeApp = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
            StartAdobe = Shell("" & AdobeApp & " " & Chr(34) & fn & Chr(34) & "", 1)
     
            Application.Wait (Now() + TimeValue("00:00:02"))
            SendKeys ("^a")
            Application.Wait (Now() + TimeValue("00:00:01"))
            SendKeys ("^c")
            Application.Wait (Now() + TimeValue("00:00:01"))
            SendKeys ("^q")
            Application.Wait (Now() + TimeValue("00:00:02"))
            AppActivate strAppCap
            Worksheets("ExtractedText").Activate
            'Sheets("ExtractedText").Cells(1, cc * 2 - 1).Select
            'SendKeys ("^v")
            'Application.Wait (Now() + TimeValue("00:00:10"))
            On Error GoTo errmsg
            Range(Cells(1, cc * 2 - 1), Cells(1, cc * 2 - 1)).PasteSpecial Paste:=xlPasteValues
errmsg:
            MsgBox (Err.Description)
            
            
            Application.Wait (Now() + TimeValue("00:00:15"))
            i = i + 1
            cc = cc + 1
        Else: GoTo jumpOut
        End If
    Next cell
jumpOut: