Hi,

A folder has several word documents. These need to be opened from
Excel and checked for existence of a string. If the string exists, the
name of the file needs to be written in the Excel workbook with a
hyperlink to the word document.

Please help with sample code/pointers.

Thanks in Advance for the help.

Regards,
Raj

Dear Raj

Please try the below and feedback. Set reference to Microsoft Word Object
Library from VBE Tools|References Dialog Box.


Sub SearchStringinWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir("c:\*.doc", vbNormal)
Do While strFile < ""

Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
If InStr(1, wrdDoc.Range.Text, strSearchString, vbTextCompare) 0 Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
End If
wrdDoc.Close


strFile = Dir
Loop


Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Raj" wrote:

Hi,

A folder has several word documents. These need to be opened from
Excel and checked for existence of a string. If the string exists, the
name of the file needs to be written in the Excel workbook with a
hyperlink to the word document.

Please help with sample code/pointers.

Thanks in Advance for the help.

Regards,
Raj

A minor change...Hardcoded path replaced with variable..

Sub SearchStringinWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir(strFolder & "*.doc", vbNormal)
Do While strFile < ""

Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
If InStr(1, wrdDoc.Range.Text, strSearchString, vbTextCompare) 0 Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
End If
wrdDoc.Close


strFile = Dir
Loop


Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

--
If this post helps click Yes
---------------
Jacob Skaria


"Raj" wrote:

Hi,

A folder has several word documents. These need to be opened from
Excel and checked for existence of a string. If the string exists, the
name of the file needs to be written in the Excel workbook with a
hyperlink to the word document.

Please help with sample code/pointers.

Thanks in Advance for the help.

Regards,
Raj

On Apr 20, 10:45*am, Jacob Skaria
wrote:
A minor change...Hardcoded path replaced with variable..

Sub SearchStringinWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir(strFolder & "*.doc", vbNormal)
Do While strFile < ""

Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
If InStr(1, wrdDoc.Range.Text, strSearchString, vbTextCompare) 0 Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
End If
wrdDoc.Close

strFile = Dir
Loop

Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

--
If this post helps click Yes
---------------
Jacob Skaria



"Raj" wrote:
Hi,

A folder has several word documents. These need to be opened from
Excel and checked for existence of a string. If the string exists, the
name of the file needs to be written in the Excel workbook with a
hyperlink to the word document.

Please help with sample code/pointers.

Thanks in Advance for the help.

Regards,
Raj- Hide quoted text -

- Show quoted text -

Thanks a lot. Exactly what I wanted. However, two more requirements
have cropped up.
1. All instances of the word have to be highlighted in the Word
document in green.
2. In the column to the right of the hyperlink in the Worksheet, the
count should be displayed.

Thanks, once again, for the help.

Regards,
Raj

Raj, modified as per your request

Sub test1()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long
Dim intCount As Integer

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir("c:\*.doc", vbNormal)
Do While strFile < ""
Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
intCount = 0

wrdApp.Options.DefaultHighlightColorIndex = wdYellow
With wrdDoc.Range.Find
.Text = strSearchString
.Replacement.Text = strSearchString
.Replacement.Highlight = True
.MatchCase = False
.MatchWholeWord = False
.Execute Replace:=wdReplaceAll
End With

If UBound(Split(UCase(wrdDoc.Range.Text), UCase(strSearchString))) < 0
Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
ActiveSheet.Range("b" & lngRow) = UBound(Split(UCase(wrdDoc.Range.Text),
UCase(strSearchString)))
wrdDoc.Save
End If

wrdDoc.Close
strFile = Dir
Loop


Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub


If this post helps click Yes
---------------
Jacob Skaria

On Apr 21, 2:18*pm, Jacob Skaria
wrote:
Raj, modified as per your request

Sub test1()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long
Dim intCount As Integer

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir("c:\*.doc", vbNormal)
Do While strFile < ""
Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
intCount = 0

* * wrdApp.Options.DefaultHighlightColorIndex = wdYellow
* * With wrdDoc.Range.Find
* * * * .Text = strSearchString
* * * * .Replacement.Text = strSearchString
* * * * .Replacement.Highlight = True
* * * * .MatchCase = False
* * * * .MatchWholeWord = False
* * * * .Execute Replace:=wdReplaceAll
* * End With

* * If UBound(Split(UCase(wrdDoc.Range.Text), UCase(strSearchString))) < 0
Then
* * lngRow = lngRow + 1
* * ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
* * ActiveSheet.Range("b" & lngRow) = UBound(Split(UCase(wrdDoc.Range.Text),
UCase(strSearchString)))
* * wrdDoc.Save
* * End If

wrdDoc.Close
strFile = Dir
Loop

Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

If this post helps click Yes
---------------
Jacob Skaria

Thanks a Ton, Jacob. That was great help.

Regards,
Raj

Cheers...

If this post helps click Yes
---------------
Jacob Skaria


"Raje" wrote:

On Apr 21, 2:18 pm, Jacob Skaria
wrote:
Raj, modified as per your request

Sub test1()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long
Dim intCount As Integer

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir("c:\*.doc", vbNormal)
Do While strFile < ""
Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
intCount = 0

wrdApp.Options.DefaultHighlightColorIndex = wdYellow
With wrdDoc.Range.Find
.Text = strSearchString
.Replacement.Text = strSearchString
.Replacement.Highlight = True
.MatchCase = False
.MatchWholeWord = False
.Execute Replace:=wdReplaceAll
End With

If UBound(Split(UCase(wrdDoc.Range.Text), UCase(strSearchString))) < 0
Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
ActiveSheet.Range("b" & lngRow) = UBound(Split(UCase(wrdDoc.Range.Text),
UCase(strSearchString)))
wrdDoc.Save
End If

wrdDoc.Close
strFile = Dir
Loop

Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

If this post helps click Yes
---------------
Jacob Skaria

Thanks a Ton, Jacob. That was great help.

Regards,
Raj

How modify Sub if searching strings are from range G2 down as follow:

G2 head-ache
G3 tooth-ache
G4 malaria
....

and create one Worksheet named with every searching string (illness), so
looping thru G2:Gn ?

Thanks in advance.
Regards,
Gianni.

"Jacob Skaria" ha scritto nel
messaggio ...
A minor change...Hardcoded path replaced with variable..

Sub SearchStringinWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir(strFolder & "*.doc", vbNormal)
Do While strFile < ""

Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
If InStr(1, wrdDoc.Range.Text, strSearchString, vbTextCompare) 0 Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
End If
wrdDoc.Close


strFile = Dir
Loop


Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

--
If this post helps click Yes
---------------
Jacob Skaria


"Raj" wrote:

Hi,

A folder has several word documents. These need to be opened from
Excel and checked for existence of a string. If the string exists, the
name of the file needs to be written in the Excel workbook with a
hyperlink to the word document.

Please help with sample code/pointers.

Thanks in Advance for the help.

Regards,
Raj

Sorry for my previous post not so clear.
Pls. read:

and make New Worksheets with Name of each Searching String (illness), so
looping thru G2:Gn ?
Regards,
Gianni.


"Big John" ha scritto nel messaggio
.. .
How modify Sub if searching strings are from range G2 down as follow:

G2 head-ache
G3 tooth-ache
G4 malaria
...

and create one Worksheet named with every searching string (illness), so
looping thru G2:Gn ?

Thanks in advance.
Regards,
Gianni.

"Jacob Skaria" ha scritto nel
messaggio ...
A minor change...Hardcoded path replaced with variable..

Sub SearchStringinWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim strFolder As String
Dim strFile As String
Dim strSearchString As String
Dim lngRow As Long

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False

strFolder = "c:\"
strSearchString = "jacob"
strFile = Dir(strFolder & "*.doc", vbNormal)
Do While strFile < ""

Set wrdDoc = wrdApp.Documents.Open(strFolder & strFile)
If InStr(1, wrdDoc.Range.Text, strSearchString, vbTextCompare) 0 Then
lngRow = lngRow + 1
ActiveSheet.Range("A" & lngRow).Formula = "=HYPERLINK(""" & strFolder &
strFile & """,""" & strFile & """)"
End If
wrdDoc.Close


strFile = Dir
Loop


Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

End Sub

--
If this post helps click Yes
---------------
Jacob Skaria