Modify macro so it searches files in subfolders

[swaggerbox]

I need the macro below to search string inside subfolders. What would I need to do to modify this?





Sub LocateStringInFolder()
Dim vString As String
Dim sPath As String
Dim strFile As String
Dim fso As New FileSystemObject
Dim sfile As TextStream
Dim line As String

vString = "Something"
sPath = "C:\MyData\"
strFile = Dir(sPath & "*.txt")

Do While strFile <> ""
Set sfile = fso.OpenTextFile(sPath & strFile)
If InStr(1, sfile.ReadAll, vString, vbTextCompare) > 0 Then
MsgBox strFile
End If
sfile.Close
Set sfile = Nothing
Set fso = Nothing
strFile = Dir()
Loop

End Sub

[Kenneth Hobs]

I could show you an fso method to get the filenames but this method works well too.

'http://www.mrexel.com/forum/excel-questions/869792-run-same-macro-multiples-files-same-folder.html

Sub Test_kBatch()
kBatch "X:\FileFolder\csv\*.csv", "Module1.perco"
End Sub


Sub kBatch(myDir As String, myMacro As String, _
Optional tfSubFolders As Boolean = False)

Dim s As String, a() As String, v As Variant

If tfSubFolders Then
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b /s").StdOut.ReadAll
Else
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b").StdOut.ReadAll
End If

a() = Split(s, vbCrLf)
If UBound(a) = -1 Then
MsgBox myDir & " files not found.", vbCritical, "Macro Ending"
Exit Sub
End If
ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr

For Each v In a()
If tfSubFolders Then
'Debug.Print v
Application.Run myMacro, v
Else
s = Left$(myDir, InStrRev(myDir, "\"))
Application.Run myMacro, s & v
End If
Next v
End Sub


Sub perco(aFile As String)
Dim MyString As String, MyVals As Variant, c As Range, lr As Long
Dim wb As Workbook

If Len(Dir(aFile)) = 0 Then
MsgBox aFile & " does not exist.", vbCritical, "Macro Ending"
Exit Sub
End If

Set wb = Workbooks.Open(aFile)

lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each c In Range("A1:A" & lr)
MyString = c.Value
MyVals = Split(MyString, ",")
MyVals(5) = "^^"
c.Value = Replace(Join(MyVals, ","), ",^^,", ",")
Next c

wb.Close True
End Sub