Loop through Word documents from Excel
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
|