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
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
Code:
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
Else
If Option1.Value = True Then
SelectFileOpenDialog
Text1.Text = MyFilePath
ElseIf Option2.Value = True Then
SelectFileOpenDialog1
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
'Application.Windows(sNewFileName).Activate
'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
Else
' 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
Next
If wrdDoc Is Nothing Then
' not open
Set wrdDoc = WordApp.Documents.Open(WDoc)
End If
End If
WordApp.Activate
'AppActivate ("Microsoft Word")
Dim currDoc As Document
Set currDoc = ActiveDocument
'currDoc.ActiveWindow.Activate
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)
currRng.Select
With Selection.Find
.ClearFormatting
.Text = MyStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute
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)
.Select
.Copy
Documents("MyOutput.docx").Activate
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.Paste
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
r.Select
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
r.Select
Do
i1 = Selection.Information(wdFirstCharacterLineNumber)
Selection.GoTo what:=wdGoToLine, which:=wdGoToPrevious, Count:=1, Name:=""
Count = Count + 1
i2 = Selection.Information(wdFirstCharacterLineNumber)
Loop Until i1 = i2
r.Select
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
wdDoc.Range.Paste
For CurrentDocument = 1 To (wdApp.Documents.Count)
sNewFileName = wdApp.Documents.Item(CurrentDocument).Path & "\" & wdApp.Documents.Item(CurrentDocument).Name
Next
sNewFileName = Right(sNewFileName, Len(sNewFileName) - 1)
sNewFileName = sNewFileName & ".docx"
wdApp.Visible = True
' Set wdDoc = Nothing
' Set wdApp = Nothing
MsgBox "done"
End Sub