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

Z

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

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
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
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Marc L said:
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
Click to expand...

If Dir(V(R, 1)) > "" Then is problem.
Can put the sheet name?
 
Upvote 0
Zot said:
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
Click to expand...
Nope, it has not worked.
 
Upvote 0
zeo1 said:
Nope, it has not worked.
Click to expand...
Zot said:
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
Click to expand...
Worked this time. Thank you. What if the file format is with .log or .docx extension.
 
Upvote 0
zeo1 said:
Worked this time. Thank you. What if the file format is with .log or .docx extension.
Click to expand...
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Copying files to a newly created folder named from data within spreadsheet
Replies
2
Views
205
AndyEd
A
H
  • Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
136
harmless92
H
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
393
GarnesGambit
G
T
  • Question
How do you populate a list of Sharepoint Files in A combobox
Replies
0
Views
273
thardin
T
J
  • Question
VBA to count occurrences of the keywords in each file in a folder and sub folders
Replies
5
Views
594
JakeP
J

Forum statistics

Threads
1,214,590
Messages
6,120,421
Members
448,961
Latest member
nzskater

Share this page

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
Back
Top