Listing text files based on search value - returns multiple instances of same record

[bifjamod]

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

[p45cal]

Try adding 1 line:


End With
Exit do
End If
This is the quick-and-easy but lazy way to speed it up a little and stop duplicates but the code could be significantly (I think) speeded up with a re-write.

[bifjamod]

This is the quick-and-easy but lazy way to speed it up a little and stop duplicates but the code could be significantly (I think) speeded up with a re-write.

Thank you! I learned something - did not know Exit Do was an option. I agree that a re-write would help; mostly, I get along withing mashing together chunks of other scripts until I get the results I'm looking for. However, I am making an effort to actually learn some of this stuff, so maybe down the road I'll be able to re-write this.

[snb]

sub M_snb()
c00=Cells(1, 2).Value
c01="F:\data\MASTER\ARCHIVE\"
sn=filter(split(createobject("wscript.shell").exec("cmd /c dir " & c01 & "*.txt /b").stdout.readall,vbcrlf,".txt")

with createobject("scripting.filesystemobject")
for each it in sn
if instr(1,.opentextfile(c01 & it).readall,c00,1)>0 then activesheet.Hyperlinks.Add activesheet.cells(rows.count,1).end(xlup).offset(1), c01 & it, , , it
next
end with
End sub