vba code to read a pdf using shell - office 2010

gistfile1.txt

Public Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long


Sub GetData()

Dim s As Worksheet
Dim rngCell As Range
Dim strResult As String

Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 'Create a FileDialog object as a File Picker dialog box
Dim vrtSelectedItem As Variant
Application.ScreenUpdating = False    'speed up macro execution
Application.DisplayAlerts = False         'Disables error messages


'Sub OPENFILE()
With fd
    'Use a With...End With block to reference the FileDialog object.
    'Use the Show method to display the File Picker dialog box and return the user's action.
    'The user pressed the action button.
    'On Error GoTo ErrMsg
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            
            Set s = ActiveWorkbook.Sheets.Add
            aa = Replace(UCase(Mid$(vrtSelectedItem, InStrRev(vrtSelectedItem, "\") + 1)), ".PDF", "")
            aa = Replace(aa, " ", "")
            aa = Replace(aa, "-", "")
            s.Name = aa
        
            rc = ShellExecute(0, "open", vrtSelectedItem, vbNullString, vbNullString, 0)
            Application.CutCopyMode = True
            'Wait some time
            Application.Wait Now + TimeValue("00:00:03") ' wait 3 seconds
            DoEvents
            'IN ACROBAT :
            'SELECT ALL
            DoEvents
            SendKeys "^a"
                'COPY
            DoEvents
            SendKeys "^c"
            'EXIT (Close & Exit)
            Application.Wait Now + TimeValue("00:00:02") ' wait 3 seconds
            DoEvents
            SendKeys "^q"
            'Wait some time
            Application.Wait Now + TimeValue("00:00:03") ' wait 3 seconds
            'Paste
            DoEvents
            s.Paste
            Application.Wait Now + TimeValue("00:00:02") ' wait 3 seconds
            DoEvents
            'Close Adobe File and Window
            SendKeys ("^w"), True
            
            Set rngCell = s.UsedRange.Cells
            
            For Each rng In rngCell.Cells
                strResult = strResult & " " & rng.Text
            Next rng
            
            Do While InStr(1, strResult, "  ") > 0
                strResult = Replace(strResult, "  ", " ")
            Loop
            
            s.Cells.Clear
            s.Cells(1, 1) = Trim(strResult)
            s.Columns(1).ColumnWidth = 100
            s.Columns(1).WrapText = True
            
        Next vrtSelectedItem

    
    End If
    End With

    On Error GoTo ErrMsg:
ErrMsg:
       If Err.Number = 1004 Then
       MsgBox "You Cancelled the Operation" 'The User pressed cancel
       Exit Sub
       End If

    

Application.ScreenUpdating = True    'refreshes the screen

End Sub