bifjamod
04-02-2016, 12:10 PM
My script is intended to search the text files in a folder for a keyword, then list the matching files to a spreadsheet. Because the keyword might exist in the text file in multiple lines, when that is the case, the file is listed multiple times.
How can I restrict the data return to just the first instance found? I'm thinking of adding an if/then based on whether the file name matches the previous line, but that seems to be a cheap workaround.
Additionally, does anyone have a suggestion on how I could speed this process up? With potentially thousands of text files to search, this process could take longer than I'd like. Fortunately (I suppose), the text files are generally small.
Sub ListMatchingACEResults()
'04/02/16 Script parses data archives of ACE results and lists matching files
Dim strSearchString As String
Dim fso As New FileSystemObject
Dim file As TextStream
Dim path As String
Dim strFile As String
Dim line As String
Dim Cell As Range
strSearchString = Cells(1, 2).Value
path = "F:\data\MASTER\ARCHIVE\"
strFile = Dir(path & "*.*")
Do While strFile <> ""
Set file = fso.OpenTextFile(path & strFile)
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, strSearchString, vbTextCompare) > 0 Then
With ActiveSheet
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Hyperlinks.Add Range("A" & NextRow), path & strFile, , , strFile
End With
End If
Loop
file.Close
Set file = Nothing
Set fso = Nothing
strFile = Dir$()
Loop
MsgBox "Search Complete"
End Sub
How can I restrict the data return to just the first instance found? I'm thinking of adding an if/then based on whether the file name matches the previous line, but that seems to be a cheap workaround.
Additionally, does anyone have a suggestion on how I could speed this process up? With potentially thousands of text files to search, this process could take longer than I'd like. Fortunately (I suppose), the text files are generally small.
Sub ListMatchingACEResults()
'04/02/16 Script parses data archives of ACE results and lists matching files
Dim strSearchString As String
Dim fso As New FileSystemObject
Dim file As TextStream
Dim path As String
Dim strFile As String
Dim line As String
Dim Cell As Range
strSearchString = Cells(1, 2).Value
path = "F:\data\MASTER\ARCHIVE\"
strFile = Dir(path & "*.*")
Do While strFile <> ""
Set file = fso.OpenTextFile(path & strFile)
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, strSearchString, vbTextCompare) > 0 Then
With ActiveSheet
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Hyperlinks.Add Range("A" & NextRow), path & strFile, , , strFile
End With
End If
Loop
file.Close
Set file = Nothing
Set fso = Nothing
strFile = Dir$()
Loop
MsgBox "Search Complete"
End Sub