Update current macro in searching string in folder and put the result in column

darkhangelsk

New Member
Joined
Feb 10, 2013
Messages
27
Hi,

I currently have a macro to search words in folder and put the result in my excel. However, it only gives me one result where i want to give me all words found in the text files available in the folder.

Sample: If i have 2 words found on the text1.txt it will give me the result 2 rows showing the words found on that file, and so on for the next file.

I tried to tweak it, but not successful. i hope someone can get me the new code. Thanks in advance!

Here's my current code:
HTML:
' 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("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 NextFileFileHandler:
    Err.Clear
    Resume NextFileNextFile:
    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 NextSubFolderSubFolderHandler:
    Err.Clear
    Resume NextSubFolderNextSubFolder:
  Next objSubfolder
  ExitHandler:
  Set objTextStream = Nothing
  Set objSubfolder = Nothing
  Set objFolder = Nothing
  Set objFile = Nothing
End Sub
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

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