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