' These 5 lines must go at' the top of the module:
Const ForReading = 1
Dim m_vntSearchItems As Variant
Dim m_astrResults() As String
Dim m_objFileSystem As Object
Dim m_lngCounter As Long
Public Sub SearchFiles()
' ++++++++++++++++++'RUN THIS PROCEDURE' ++++++++++++++++++
Const strFOLDER_PATH = "C:\Doucments\Logs" ' <-- the folder you want to search
Dim i As Integer
Dim j As Long
On Error GoTo ErrorHandler
m_vntSearchItems = Array("white", "note", "gray", "black") ' <-- the items you want to search for
Erase m_astrResults
m_lngCounter = 0
Set m_objFileSystem = CreateObject("Scripting.FileSystemObject")
Call SearchFilesInFolder(strFOLDER_PATH)
If m_lngCounter > 0 Then
With ThisWorkbook.Sheets.Add
With .Range("A1:D1")
.Value = Array("Folder Path", "File Name", "Text Found", "Line")
.Font.Bold = True
End With
For j = 1 To m_lngCounter
For i = 1 To UBound(m_astrResults)
.Cells(j + 1, i).Value = m_astrResults(i, j)
Next i
Next j
With .Columns("A:D")
.AutoFilter
.AutoFit
End With
End With
With ThisWorkbook.Windows(1)
.SplitRow = 1
.FreezePanes = True
End With
End If
MsgBox Format(m_lngCounter, "#,0") & " file(s) were found.", vbInformation
ExitHandler:
Set m_objFileSystem = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
Private Sub SearchFilesInFolder(strFolderPath As String)
Dim strFileExtension As String
Dim objTextStream As Object
Dim objSubfolder As Object
Dim strFilePath As String
Dim strFileText As String
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim ii As Long
On Error GoTo ExitHandler
Set objFolder = m_objFileSystem.GetFolder(strFolderPath)
For Each objFile In objFolder.Files
On Error GoTo FileHandler
strFilePath = objFile.Path
strFileExtension = LCase(m_objFileSystem.GetExtensionName(strFilePath))
If strFileExtension = "txt" Or strFileExtension = "csv" Then
Set objTextStream = m_objFileSystem.OpenTextFile(strFilePath, ForReading)
ii = 0
Do Until objTextStream.AtEndOfStream
strFileText = objTextStream.ReadLine
ii = ii + 1
For i = LBound(m_vntSearchItems) To UBound(m_vntSearchItems)
If InStr(1, strFileText, m_vntSearchItems(i), vbTextCompare) > 0 Then
m_lngCounter = m_lngCounter + 1
ReDim Preserve m_astrResults(1 To 4, 1 To m_lngCounter)
m_astrResults(1, m_lngCounter) = objFile.ParentFolder
m_astrResults(2, m_lngCounter) = objFile.Name
m_astrResults(3, m_lngCounter) = m_vntSearchItems(i)
m_astrResults(4, m_lngCounter) = ii
End If
Next i
Loop
objTextStream.Close
End If
GoTo NextFile
FileHandler:
Err.Clear
Resume NextFile
NextFile:
On Error Resume Next
objTextStream.Close
Next objFile
On Error GoTo ExitHandler
For Each objSubfolder In objFolder.SubFolders
On Error GoTo SubFolderHandler
Call SearchFilesInFolder(objSubfolder.Path)
GoTo NextSubFolder
SubFolderHandler:
Err.Clear
Resume NextSubFolder
NextSubFolder:
Next objSubfolder
ExitHandler:
Set objTextStream = Nothing
Set objSubfolder = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub
