Sub FindWord()
Dim FSO As Object
Dim text As Object
Dim Contents As String
Dim nCount As Long
Dim cell As Range, rngFileName As Range
Dim wsMaster As Worksheet
Dim wbMaster As Workbook
Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("Sheet1") ' Rename if required.
strFind = "Apple" ' Set string to search here
Set rngFileName = wsMaster.Range("A2", wsMaster.Cells(Rows.Count, "A").End(xlUp))
' Assuming filename list starts from A2. Format: "Path\Filename.txt"
Application.ScreenUpdating = False
For Each cell In rngFileName
FName = cell
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FName) Then
'Open the file for reading
Set text = FSO.OpenTextFile(FName, 1)
'Load the text contents to variable
Contents = text.ReadAll
text.Close
cell.Offset(0, 1) = CountWord(Contents, "Apple", bWhole:=False, bMatchCase:=False)
Else
MsgBox "File does not exist"
End If
Next
Set FSO = Nothing
End Sub
Public Function CountWord(ByVal sText As String, ByVal sWord As String, ByVal bWhole As Boolean, ByVal bMatchCase As Boolean) As Long
Dim str() As String
If Not bMatchCase Then
sWord = UCase(sWord)
sText = UCase(sText)
End If
str = Split(sText, sWord)
CountWord = UBound(str)
End Function