Hi All,

I am trying to search for a keyword in a pdf file and retrieve that paragraph. First i open the pdf file, copy whole content, paste into a word doc and then run the macro which will give me the desired results into another doc(which is already open). I've done this in VBA + MS Word. Now i nedd to create a form in VB6 for this. Here i am facing some problems.
In the form i have 2 option buttons (source file type)- one for pdf & one for word file. Browse button will copy and paste the file path to a textbox. Then convert button will copy the contents and paste to word doc.

After entering keyword, when the search button is clicked, i cant activate the doc inorder to run the search portion of macro. I am able to get the name of newly created doc. Kindly review my code and suggest some solutions. I am a newbie to vb6

Dim PathFile, MyStr, apppath As String
Private 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
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2

Private Sub Browse_Click()
If Option1.Value = False And Option2.Value = False Then
    MsgBox "Select the source file type"
    Exit Sub
    If Option1.Value = True Then
        Text1.Text = MyFilePath
    ElseIf Option2.Value = True Then
        Text1.Text = MyFilePath
    End If
End If
End Sub

Private Sub Search_Click()
If Text2.Text = "" Then
MsgBox "Enter the keyword to be searched"
Exit Sub
Else: MyStr = Text2.Text
End If

'appWD.Visible = True

    Dim WordApp As Object
    Dim wrdDoc As Object
    Dim tmpDoc As Object
    Dim WDoc As String
    'Dim myDoc As String
    'myDoc = sNewFileName
    WDoc = sNewFileName
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If WordApp Is Nothing Then
         ' no current word application
        Set WordApp = CreateObject("Word.application")
        Set wrdDoc = WordApp.Documents.Open(WDoc)
        WordApp.Visible = True
         ' word app running
        For Each tmpDoc In WordApp.Documents
            If StrComp(tmpDoc.FullName, WDoc, vbTextCompare) = 0 Then
                 ' this is your doc
                Set wrdDoc = tmpDoc
                Exit For
            End If
        If wrdDoc Is Nothing Then
             ' not open
            Set wrdDoc = WordApp.Documents.Open(WDoc)
        End If
    End If


'AppActivate ("Microsoft Word")
Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String

Selection.HomeKey Unit:=wdStory

For Each currPara In docRng.Paragraphs

Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End)
With Selection.Find
    .Text = MyStr
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With

If Selection.Find.Found Then
MyPara = GetParNum(Selection.Range)
MyLine = GetAbsoluteLineNum(Selection.Range)
MyPage = Selection.Information(wdActiveEndPageNumber)

With currDoc.Range(currPara.Range.Start, currPara.Range.End - 1)
    Selection.Font.Bold = True
    Selection.TypeText Text:="Page number: " & MyPage & " Paragraph number: " & MyPara & " Line number: " & MyLine
    Selection.InsertBreak Type:=wdSectionBreakContinuous
    Selection.Font.Bold = False
    Selection.InsertBreak Type:=wdSectionBreakContinuous
End With

End If

Next currPara

End Sub

Function GetParNum(r As Range) As Integer
    Dim rParagraphs As Range
    Dim CurPos As Long
    CurPos = ActiveDocument.Bookmarks("\startOfSel").Start
    Set rParagraphs = ActiveDocument.Range(Start:=0, End:=CurPos)
    GetParNum = rParagraphs.Paragraphs.Count
End Function
Function GetAbsoluteLineNum(r As Range) As Integer
    Dim i1 As Integer, i2 As Integer, Count As Integer, rTemp As Range
        i1 = Selection.Information(wdFirstCharacterLineNumber)
        Selection.GoTo what:=wdGoToLine, which:=wdGoToPrevious, Count:=1, Name:=""
        Count = Count + 1
        i2 = Selection.Information(wdFirstCharacterLineNumber)
    Loop Until i1 = i2
    GetAbsoluteLineNum = Count
End Function

Private Sub Convert_Click()
Call method1_using_sendkey
End Sub
Sub method1_using_sendkey()
Dim task
PathFile = Text1.Text

ShellExecute Me.hwnd, "open", PathFile, vbNullString, vbNullString, SW_SHOWNORMAL

Sleep 1000

SendKeys "^a", True

Sleep 1000
SendKeys "^c"

Sleep 1000
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
 Sleep 1000

For CurrentDocument = 1 To (wdApp.Documents.Count)
sNewFileName = wdApp.Documents.Item(CurrentDocument).Path & "\" & wdApp.Documents.Item(CurrentDocument).Name
sNewFileName = Right(sNewFileName, Len(sNewFileName) - 1)
sNewFileName = sNewFileName & ".docx"

    wdApp.Visible = True
'    Set wdDoc = Nothing
'    Set wdApp = Nothing
MsgBox "done"
End Sub