Search string/s in folder and subfolders and put results into column

darkhangelsk

New Member
Joined
Feb 10, 2013
Messages
27
Hi,

i've been trying to create a macro that will look to all sub folders. sub folders have word documents and notepads, but i'll just be looking into notepad files. within the notepad, it will be looking for a certain word. Then if the word found in the notepad, it will populate the subfolder names and full path in the excel.

i have sample but something wrong into it:
Code:
Sub FindText()

 Dim FileName As String
 Dim FolderPath As String
 Dim FSO As Object
 Dim I As Integer
 Dim SearchForWords As Variant
 Dim Text As String
 Dim TextFile As Object
 
  'Change these arrays to word you want to find 
   SearchForWords = Array("Note", "noTe", "notE")
 
  'Change the folder path to where your text files are.
   FolderPath = "C:\Project\"
   
     Set FSO = CreateObject("Scripting.FileSystemObject")
   
     FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
     FileName = Dir(FolderPath & "\*.txt")
   
     Do While FileName <> ""
       Filespec = FolderPath & FileName
      
         Set TextFile = FSO.OpenTextFile(Filespec, 1, False)
           Text = TextFile.ReadAll
         TextFile.Close
         
      
         Set TextFile = FSO.OpenTextFile(Filespec, 2, False)
           For I = 0 To UBound(SearchForWords)
             With ActiveSheet
             Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = I
             I = I + 1
             End With
           Next I
         TextFile.Write Text
         TextFile.Close
       FileName = Dir()
     Loop
     
End Sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Try using this instead:

Code:
' 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:\Users\John\Documents\" ' <-- the folder you want to search
  Dim i As Integer
  Dim j As Long
  
  On Error GoTo ErrorHandler
  m_vntSearchItems = Array("the", "and", "that", "have") ' <-- 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:C1")
        .Value = Array("Folder Path", "File Name", "Text Found")
        .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:C")
        .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
  
  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)
      strFileText = objTextStream.ReadAll()
      objTextStream.Close
      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 3, 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)
          Exit For
        End If
      Next i
    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
 
Upvote 0
Solution

Forum statistics

Threads
1,215,766
Messages
6,126,762
Members
449,336
Latest member
p17tootie

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