Searching a huge number of strings from Excel to a large number of Text files

A few suggestions:

1. Most obvious (and simple) step is to read the entire file, and not one line at the time

   Change this:

   Set file = fso.OpenTextFile(Path)
   Do While Not file.AtEndOfLine
       Line = file.ReadLine
       If InStr(1, Line, theString, vbTextCompare) > 0 Then
           ws2.Cells(K, 4).Value = Str
           ws2.Cells(K, 5).Value = fname
           ws2.Cells(K, 6).Value = "Srting is found"
           flag = "Y"
       End If
   Loop
   

   To this:

   Set file = fso.OpenTextFile(Path)
   
   fullFile = file.ReadAll
   
   If InStr(1, fullFile, theString, vbTextCompare) > 0 Then
       With ws2
           .Cells(K, 4).Value2 = theString
           .Cells(K, 5).Value2 = fname
       End With
       flag = "Y"
   End If
   

   It eliminates the do-while loop. More details about .ReadAll().

2. Store Str and fname info into an array, then commit the entire array to the worksheet at the end, instead of writing to each cell separately.

3. The "Find" command in DOS might be faster and it can also provide the line number(s) where the string is found:

   Find /?

   Searches for a text string in a file or files.

   FIND [/V] [/C] [/N] [/I] [/OFF[LINE]] "string" [[drive:][path]filename[ ...]]

I agree with @paul bica about the use of .ReadAll but just wanted to add a couple extra points about your code (but then see point 7).

1. In your original code in StringExistsInFile you should remember to quit the loop once the string is found. Otherwise you will continue to needlessly read the rest of the file.

   Set file = fso.OpenTextFile(Path)
   Do While Not file.AtEndOfLine
       Line = file.ReadLine
       If InStr(1, Line, theString, vbTextCompare) > 0 Then
           ws2.Cells(K, 4).Value = Str
           ws2.Cells(K, 5).Value = fname
           ws2.Cells(K, 6).Value = "Srting is found"
           flag = "Y"
           ' Remember to quit the loop
           Exit Do
       End If
   Loop
   

2. In ShowFolderList there are some things to refine: you're not defining most of the variable types (Dim f, f1, fc, s, sFldr) and you've got an If ... Then ... Else ... which is redundant because both give the same outcome. You re-use the f1 variable but the first time it represents Folder objects and the second time File objects. Best not to re-use variables, maybe simple loop counters are ok but definitely shouldn't refer them to different things.

3. In StringExistsInFile you've got a bunch of variable assignments that aren't needed and generally confuse what is happening:

   theString = str 
   path = fpth  
   StrFile = Dir(path)  
   

   You are using StrFile = Dir(path) and a Do While ... Loop but you then open fso.OpenTextFile(path). You already know that the file exists so you don't need to re-check it. The Dir(string) function with a Do While ... Loop is usually used when string contains some wildcards and you want to loop through all the matching files.

   The Else block in this code looks like you want to report whether every string occurs in every file but your output isn't clear on this point:

   If flag = "Y" Then
       K = K + 1
   Else
       ws2.Cells(K, 4).Value = str
       ws2.Cells(K, 5).Value = fname
       ws2.Cells(K, 6).Value = "String is not Found"
       K = K + 1
   End If
   

4. It is a good idea to avoid module-level variables because they make it difficult to track which code assigns & changes the value of the variable. You can pass variables and object references between procs. Also, when you use the Cells method always qualify it with the worksheet and, ideally, the workbook. Sometimes you are using the worksheet and other times not.

5. Use early binding for FileSystemObject and Dictionary it makes writing the code much easier. In the VBA IDE, go Tools -> References and find and select the Microsoft Scripting Runtime.

6. Indentation makes the code much easier to look at and to see at a glance where procs start & end. I indent everything except proc declarations and Dim statements but some people indent the latter as well.

7. It has just occurred to me that the slow part (relatively) of your code will be reading the file because it involves disk access. So it will probably be faster to read all your strings into an array or dictionary, then load the file into memory and loop through the array or dictionary looking for matches. If you use a dictionary the value of each key can be the count of the number of times it was found which then lets you do a summary at the end of those strings that were not found at all.

Here is the code that I ended up with

Option Explicit

Public Sub SearchInSQSDatabase_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim outputRange As Range
Dim stringToFind As String
Dim callString As String
Dim dictOfStrings As Scripting.Dictionary
Dim dictKey As Variant
Dim i As Integer

    Application.ScreenUpdating = False

    Set ws1 = ThisWorkbook.Sheets(1)
    Set ws2 = ThisWorkbook.Sheets(2)

    i = 1
    ws2.Cells(1, 4).Value = "Search String"
    ws2.Cells(1, 5).Value = "Files"
    ws2.Cells(1, 6).Value = "Comments"
    Set outputRange = ws2.Cells(2, 4)

    ' dictionary will be all the strings to find with a count
    ' of the number of times they were found
    Set dictOfStrings = New Dictionary

    Do While ws1.Cells(RowIndex:=i, ColumnIndex:=1).Value <> ""
         'ws2.Cells(i, 1).Value = Cells(i, 1).Value
         stringToFind = CStr(ws1.Cells(RowIndex:=i, ColumnIndex:=1).Value)
         ' Cannot add the same value to dictionary twice
         If Not dictOfStrings.Exists(stringToFind) Then
            dictOfStrings.Add stringToFind, 0
            callString = "CALL " & stringToFind
            dictOfStrings.Add callString, 0
         Else
            MsgBox stringToFind & " exists in your list more than once."
         End If
         i = i + 1
    Loop


    ShowFolderList ws1.Cells(5, 4).Value, dictOfStrings, outputRange

    ' If only want a  summary of which strings do not exist in any files
    ' then do it here
    For Each dictKey In dictOfStrings.Keys
        stringToFind = CStr(dictKey)
        If dictOfStrings.Item(stringToFind) = 0 Then
            With outputRange
                .Value = stringToFind
                .Offset(ColumnOffset:=1).Value = ""
                .Offset(ColumnOffset:=2).Value = "String NOT found in any files"
            End With
            Set outputRange = outputRange.Offset(RowOffset:=1)
        End If
    Next dictKey

    Application.ScreenUpdating = True

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Looks in startingFolder and all subfolders at each file
'and calls StringsExistInFile for each file
'Recursive proc, i.e calls itself for each subfolder.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ShowFolderList(ByRef startingFolder As String, ByRef dictOfStrings As Scripting.Dictionary, ByRef outputRange As Range)

On Error GoTo local_err

Dim fileSystem As Scripting.FileSystemObject
Dim topFolder As Scripting.Folder
Dim subFolder As Scripting.Folder
Dim thisFile As Scripting.File

    Set fileSystem = New Scripting.FileSystemObject
    Set topFolder = fileSystem.GetFolder(startingFolder)

    ' Code needs to call itself for every subfolder found
    For Each subFolder In topFolder.SubFolders
        ShowFolderList subFolder.path, dictOfStrings, outputRange
    Next subFolder

    For Each thisFile In topFolder.Files
        StringsExistInFile thisFile, dictOfStrings, outputRange
    Next thisFile

local_exit:
    Exit Sub
local_err:
    MsgBox Err & " " & Err.Description
    Resume local_exit
    Resume
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Check for each String in theFile. Writes the result
'to the output range
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub StringsExistInFile(ByRef theFile As Scripting.File, ByRef dictOfStrings As Scripting.Dictionary, ByRef outputRange As Range)

Dim inputStream As Scripting.TextStream
Dim fullFile As String
Dim stringToFind As String
Dim dictKey As Variant
Dim foundOk As Boolean

    Set inputStream = theFile.OpenAsTextStream(ForReading)

    fullFile = inputStream.ReadAll
    inputStream.Close

    ' Loops through the dictionary of strings to find
    For Each dictKey In dictOfStrings.Keys
        stringToFind = CStr(dictKey)
        If InStr(1, fullFile, stringToFind, vbTextCompare) > 0 Then
            foundOk = True
            ' Update the count in dictionary
            dictOfStrings.Item(stringToFind) = dictOfStrings.Item(stringToFind) + 1
        Else
            foundOk = False
        End If
' ************************************************************
' Uncomment whichever block of code is relevant for your needs
' ************************************************************
        ' If only want to say if the string *was* found in this file
'        If foundOk Then
'            With outputRange
'                .Value = stringToFind
'                .Offset(ColumnOffset:=1).Value = theFile.Name
'                .Offset(ColumnOffset:=2).Value = "String is found"
'            End With
'            Set outputRange = outputRange.Offset(RowOffset:=1)
'        End If
        ' But if want to say whether every string was found or not in every file
        With outputRange
            .Value = stringToFind
            .Offset(ColumnOffset:=1).Value = theFile.Name
            If foundOk Then
                .Offset(ColumnOffset:=2).Value = "String is found"
            Else
                .Offset(ColumnOffset:=2).Value = "String NOT found"
            End If
        End With
        Set outputRange = outputRange.Offset(RowOffset:=1)
    Next dictKey

End Sub