VBA: Read PDF > Copy it to Excel > Find some text reference > Copy the offset value into new sheet

[noppph]

Dear All,

I'm trying to
1. Open all PDF files in a directory using Acrobat pro then copy all text to my sheet
2. Use my keyword to find then required string(i.e. a row contain "Name: John smith" then use "Name:" to find the reference position then get "John Smith" into result sheet).

I've use the code below, but some problem to be fixed as listed below.
1. I want to keep all sheet contain data from each PDF files(i.e. sheet name "File1" will keep the data read from "File1.pdf")
2. I don't know how to find and copy the name(i.e. John smith)

Could someone please help

Thank you in advance,
Nopp

Option Explicit


Sub LoopThroughFiles()
    Dim strFile As String, strPath As String
    Dim colFiles As New Collection
    Dim i As Integer
    Dim rLog As Range, rOut As Range
    Dim wsLog As Worksheet, wsOutp As Worksheet
    
'Define the path to work with.
    strPath = "D:\Dropbox\Misc\ReadPDF_VBA\"
    strFile = Dir(strPath)
    ' Make a log sheet
    On Error Resume Next
    Set wsLog = Sheets("PdfProcessLog")
    On Error GoTo 0
    If wsLog Is Nothing Then
        Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1))
        wsLog.Name = "PdfProcessLog"
    End If
    Set rLog = wsLog.Range("A1")
    rLog.CurrentRegion.ClearContents
    rLog.Value = "PDF files copied to sheets"
    
    ' load all the files in a Collection
    While strFile <> ""
        If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then
            colFiles.Add strFile
        End If
        strFile = Dir
    Wend
    
    Application.DisplayAlerts = False
    
    'Loop through the pdf's stored in the collection
    For i = 1 To colFiles.Count
        'List filenames in Column A of the log sheet
        rLog.Offset(i, 0).Value = colFiles(i)
        strFile = Left(colFiles(i), Len(colFiles(i)) - 4)
        
        ' Delete sheet with filename if exists
        On Error Resume Next
        Set wsOutp = Sheets(strFile)
        On Error GoTo 0
        If Not wsOutp Is Nothing Then
            wsOutp.Delete
        End If
        ' (Re)Create the worksheet, give it the file name
        Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog)
        wsOutp.Name = strFile
        
        ' Now open the file, and copy contents
        OpenClosePDF colFiles(i), strPath
        CopyStep wsOutp
    Next i
    
    Application.DisplayAlerts = True


End Sub
Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String)


    Dim sAdobeApp As String
    Dim vStartAdobe As Variant
    
    sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe"
    sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe"
    vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1)
    Application.Wait (Now + TimeValue("0:00:05"))


End Sub




Private Sub CopyStep(wsOutp As Worksheet)


    ' select all & copy
    SendKeys "^a", True
    SendKeys "^c", True
     Application.Wait (Now + TimeValue("0:00:05"))
   ' Paste into the sheet from cell A1
    wsOutp.Paste Cells(1, 1)
   
    Application.Wait (Now + TimeValue("0:00:05"))
    'Activate Acrobat pro/Adobe reader
    AppActivate "Adobe Acrobat Pro"
    ' close PDF file, give 5 sec to make sure file is closed.
    SendKeys "%{F4}", True
    Application.Wait (Now + TimeValue("0:00:05"))
    
End Sub