VBA Code for Retrieving PDF Data with Adobe Acrobat Reader

[adavid]

The code below is a part of a process. The process requires two actions from the User,Action 1 & Action 3. All of the actions in Action 2 occur automatically. All of the steps in Action 3 also occur automatically with the exception of the CommandButton. that:

Action 1) Allows a User to select a PDF file

Action 2) Then opens the PDF in Acrobat Reader, removes bad characters from a file name and renames it, copies the new filepath which is used to hyperlink the entry to the original PDF, copies the PDF data into a hidden worksheet, then another hidden worksheet uses Offset(Index(VLookUp (in that exact order) formulas to extract my information from the worksheet where the PDF data was pasted

Action 3) A UserForm then allows the User to review the data before adding it to the document, then with a CommandButton adds the data to the document, hyperlinks the document name to the original file, and allows the User either repeat the process or close the UserForm.

Sub GetData()</SPAN></SPAN>
    Dim fd As FileDialog</SPAN></SPAN>
        Set fd = Application.FileDialog(msoFileDialogFilePicker) 'Create a FileDialog object as a File Picker dialog box</SPAN></SPAN>
    Dim vrtSelectedItem As Variant</SPAN></SPAN>
    Application.ScreenUpdating = False    'speed up macro execution</SPAN></SPAN>
    Application.DisplayAlerts = False         ‘Disables error messages</SPAN></SPAN>
   
    'Sub OPENFILE()</SPAN></SPAN>
    With fd</SPAN></SPAN>
        'Use a With...End With block to reference the FileDialog object.</SPAN></SPAN>
        'Use the Show method to display the File Picker dialog box and return the user's action.</SPAN></SPAN>
        'The user pressed the action button.</SPAN></SPAN>
        'On Error GoTo ErrMsg</SPAN></SPAN>
        If .Show = -1 Then</SPAN></SPAN>
            For Each vrtSelectedItem In .SelectedItems</SPAN></SPAN>
                rc = ShellExecute(0, "open", vrtSelectedItem, vbNullChar, _</SPAN></SPAN>
                vbNullChar, 0)</SPAN></SPAN>
                Application.CutCopyMode = True</SPAN></SPAN>
                'Wait some time</SPAN></SPAN>
                Application.Wait Now + TimeValue("00:00:03") ' wait 3 seconds</SPAN></SPAN>
                DoEvents</SPAN></SPAN>
                'IN ACROBAT :</SPAN></SPAN>
                'SELECT ALL</SPAN></SPAN>
                DoEvents</SPAN></SPAN>
                SendKeys "^a"</SPAN></SPAN>
                    'COPY</SPAN></SPAN>
                DoEvents</SPAN></SPAN>
                SendKeys "^c"</SPAN></SPAN>
                'EXIT (Close & Exit)</SPAN></SPAN>
                Application.Wait Now + TimeValue("00:00:02") ' wait 3 seconds</SPAN></SPAN>
                DoEvents</SPAN></SPAN>
                SendKeys "^q"</SPAN></SPAN>
                'Wait some time</SPAN></SPAN>
                Application.Wait Now + TimeValue("00:00:06") ' wait 3 seconds</SPAN></SPAN>
                'Paste</SPAN></SPAN>
                DoEvents</SPAN></SPAN>
                Sheets("Raw WAM Data").Paste Destination:=Sheets("Raw WAM Data").Range("A1")</SPAN></SPAN>
                Sheet8.Range("a50").Value = vrtSelectedItem</SPAN></SPAN>
                Application.Wait Now + TimeValue("00:00:03") ' wait 3 seconds</SPAN></SPAN>
        'Replace bad characters in the file name and Rename the file</SPAN></SPAN>
             Dim FPath As String</SPAN></SPAN>
             Dim Ndx As Integer</SPAN></SPAN>
             Dim FName As String, strPath As String</SPAN></SPAN>
             Dim strFileName As String, strExt As String</SPAN></SPAN>
             Dim NewFileName As String</SPAN></SPAN>
                Const BadChars = "@!$/'<|>*-—" ' put your illegal characters here</SPAN></SPAN>
                    If Right$(vrtSelectedItem, 1) <> "\" And Len(vrtSelectedItem) > 0 Then</SPAN></SPAN>
FilenameFromPath = GetFilenameFromPath(Left$(vrtSelectedItem, Len(vrtSelectedItem) - 1)) + Right$(vrtSelectedItem, 1)</SPAN></SPAN>
                    End If</SPAN></SPAN>
                FName = FilenameFromPath</SPAN></SPAN>
                                For Ndx = 1 To Len(BadChars) </SPAN></SPAN>
                FName = Replace$(FName, Mid$(BadChars, Ndx, 1), "_")</SPAN></SPAN>
            Next Ndx</SPAN></SPAN>
                GivenLocation =  _</SPAN></SPAN>
SRV006\Am\Master Documents\PC 2.2.11 Document For Work(DFWs)\DFWS added to DFW Track\" 'note the trailing backslash</SPAN></SPAN>
                OldFileName = vrtSelectedItem</SPAN></SPAN>
                strExt = ".pdf"</SPAN></SPAN>
                NewFileName = GivenLocation & FName & strExt</SPAN></SPAN>
                Name vrtSelectedItem As NewFileName</SPAN></SPAN>
       
‘The next three lines are not used but can be if you do not want to rename the file    </SPAN></SPAN>
            'FPath = vrtSelectedItem 'Fixing the File Path</SPAN></SPAN>
            'FPath = (Right(FPath, Len(FPath) - InStr(FPath, "#")))</SPAN></SPAN>
            'FPath = "\\" & FPath</SPAN></SPAN>
 
'pastes new file name into cell to be used with the UserForm            </SPAN></SPAN>
            Sheet8.Range("a50") = NewFileName </SPAN></SPAN>
            Next vrtSelectedItem</SPAN></SPAN>
     
        Else</SPAN></SPAN>
        End</SPAN></SPAN>
        End With</SPAN></SPAN>
       
    On Error GoTo ErrMsg:</SPAN></SPAN>
ErrMsg:</SPAN></SPAN>
    If Err.Number = 1004 Then</SPAN></SPAN>
    MsgBox "You Cancelled the Operation" ‘The User pressed cancel</SPAN></SPAN>
    Exit Sub</SPAN></SPAN>
    End If</SPAN></SPAN>
      
‘This delimits my data so I can use the Offset(Index(VLookUp formulas to locate the information on the RAW sheet</SPAN></SPAN>
            Sheet7.Activate</SPAN></SPAN>
            Sheet7.Range("A1:A1000").TextToColumns _</SPAN></SPAN>
            Destination:=Sheet7.Range("A1:A1000").Offset(0, 0), _</SPAN></SPAN>
            DataType:=xlDelimited, _</SPAN></SPAN>
            Tab:=False, _</SPAN></SPAN>
            Semicolon:=False, _</SPAN></SPAN>
            Comma:=False, _</SPAN></SPAN>
            Space:=False, _</SPAN></SPAN>
            OTHER:=True, _</SPAN></SPAN>
            OtherChar:=":"</SPAN></SPAN>
 
‘Now the UserForm launches with the desired data already in the TextBoxes  </SPAN></SPAN>
        With UserForm2</SPAN></SPAN>
        Dim h As String</SPAN></SPAN>
        h = Sheet8.Range("A50").Value ‘This is my Hyperlink to the file</SPAN></SPAN>
       
            UserForm2.Show</SPAN></SPAN>
            Set UserForm4 = UserForm2</SPAN></SPAN>
            On Error Resume Next</SPAN></SPAN>
                StartUpPosition = 0</SPAN></SPAN>
                .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)</SPAN></SPAN>
                .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)</SPAN></SPAN>
 
                UserForm4.TextBox1.Value = Sheet8.Range("A20")</SPAN></SPAN>
                UserForm4.TextBox2.Value = Sheet8.Range("A22")</SPAN></SPAN>
                UserForm4.TextBox3.Value = Sheet8.Range("A7")</SPAN></SPAN>
                UserForm4.TextBox5.Value = Sheet8.Range("A23")</SPAN></SPAN>
                UserForm4.TextBox6.Value = Sheet8.Range("A24")</SPAN></SPAN>
                UserForm4.TextBox7.Value = Sheet8.Range("A10")</SPAN></SPAN>
                UserForm4.TextBox10.Value = Date</SPAN></SPAN>
                UserForm4.TextBox12.Value = Sheet8.Range("A34")</SPAN></SPAN>
                UserForm4.TextBox13.Value = Sheet8.Range("A28")</SPAN></SPAN>
                UserForm4.TextBox14.Value = Sheet8.Range("A26")</SPAN></SPAN>
                UserForm4.TextBox17.Value = Sheet8.Range("A12")</SPAN></SPAN>
                UserForm4.TextBox19.Value = h</SPAN></SPAN>
                UserForm4.TextBox16.Value = Sheet8.Range("A18")</SPAN></SPAN>
 
        End With</SPAN></SPAN>
          
    Application.ScreenUpdating = True    'refreshes the screen</SPAN></SPAN>
 
End Sub</SPAN></SPAN>