VBA: Search text files in folder and count occurrences of a string

zeo1

New Member
Joined
Jul 10, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
Platform
  1. Windows
  2. Mobile
VBA: Search text files in the folder and count occurrences of a given string

In my excel file column A I have filenames with their locations.
I want to know how many times 'Apple' appears in each file.
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,881
Office Version
  1. 2016
Platform
  1. Windows
Try this
VBA Code:
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
        nCount = nCount + CountWord(Contents, "Apple", bWhole:=False, bMatchCase:=False)
    Else
        MsgBox "File does not exist"
    End If
Next

MsgBox strFind & " word found = " & nCount

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
 

zeo1

New Member
Joined
Jul 10, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
Platform
  1. Windows
  2. Mobile
Worked.
But I need help to get the number in respective rows in column B.
For example if:
Cell A2 has a file name with a location
Cell A3 has a file name with a location
Cell A4 has a fille name with location
Cell A10 has a fille name with location
......
Cell A100 has a file name with location

Can I get the numbers in Cell B2, B3, B4, B10, ..... B100?
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,881
Office Version
  1. 2016
Platform
  1. Windows
This will put count number in column B respective to each file. Not testing it since my work sample file in office. Time to go to bed now for me 😁

VBA Code:
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
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,725
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

An EZ VBA demonstration to paste to the worksheet module (in a general / standard module then it works with the active sheet …) :​
VBA Code:
Sub Demo1()
  Const S = "Apple"
    Dim F%, V, R&
        F = FreeFile
    With [A1].CurrentRegion.Columns
            V = .Item(1).Value2
        For R = 1 To UBound(V)
            If Dir(V(R, 1)) > "" Then
                Open V(R, 1) For Input As #F
                V(R, 1) = UBound(Split(Input(LOF(F), #F), S, , 1))
                Close #F
            Else
                V(R, 1) = Empty
            End If
        Next
           .Item(2).Value2 = V
    End With
End Sub
 

zeo1

New Member
Joined
Jul 10, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
Platform
  1. Windows
  2. Mobile
An EZ VBA demonstration to paste to the worksheet module (in a general / standard module then it works with the active sheet …) :​
VBA Code:
Sub Demo1()
  Const S = "Apple"
    Dim F%, V, R&
        F = FreeFile
    With [A1].CurrentRegion.Columns
            V = .Item(1).Value2
        For R = 1 To UBound(V)
            If Dir(V(R, 1)) > "" Then
                Open V(R, 1) For Input As #F
                V(R, 1) = UBound(Split(Input(LOF(F), #F), S, , 1))
                Close #F
            Else
                V(R, 1) = Empty
            End If
        Next
           .Item(2).Value2 = V
    End With
End Sub

If Dir(V(R, 1)) > "" Then is problem.
Can put the sheet name?
 

zeo1

New Member
Joined
Jul 10, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
Platform
  1. Windows
  2. Mobile

ADVERTISEMENT

This will put count number in column B respective to each file. Not testing it since my work sample file in office. Time to go to bed now for me 😁

VBA Code:
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
Nope, it has not worked.
 

zeo1

New Member
Joined
Jul 10, 2021
Messages
5
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2011
  6. 2010
  7. 2007
Platform
  1. Windows
  2. Mobile
Nope, it has not worked.
This will put count number in column B respective to each file. Not testing it since my work sample file in office. Time to go to bed now for me 😁

VBA Code:
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
Worked this time. Thank you. What if the file format is with .log or .docx extension.
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,881
Office Version
  1. 2016
Platform
  1. Windows
Worked this time. Thank you. What if the file format is with .log or .docx extension.
I believe as long as the document is text file which can be read by text editor, it should be no problem as long as the file is plain text, regardless the extension. The MS Word file is not plain text document. It will be different command. It should be using just FInd function in VBA
 

Forum statistics

Threads
1,148,193
Messages
5,745,263
Members
423,941
Latest member
CluelessAboutExcel

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top