Search Dir for text:

[|2eM!x]

Made this little thing so that you can search for a word in any text file in a certain path, and it will tell you if it contains the word in text1.text...kind of like a extended text search thingy

Option Explicit
Dim ff As Integer
Dim mypath As String
Dim p As String
Dim strbuff As String
 
Private Sub Command1_Click()
mypath = "C:\"
 p = Dir(mypath, vbDirectory)
 Do Until p = ""
        If InStr(p, ".txt") Then
        ff = FreeFile
            Open mypath & p For Binary As #ff
                strbuff = Input(LOF(ff), ff)
                    If InStr(strbuff, text1.Text) Then
                      List1.AddItem p
                    End If
        End If
        
        p = Dir
Loop
End Sub

[manavo11]

If you have :

p = Dir(mypath)

instead of :

p = Dir(mypath, vbDirectory)

the loop will be faster as it won't return the directories, only files

[CVMichael]

I kind of over did it, didn't I ?

I wrote the following code as a class (because of the events)
Check the attached project on how to use the class

Option Explicit
 
Public Event FindFilesCurrentDir(ByVal CurrentDirectory As String)
Public Event FindFilesFound(ByVal Path As String, ByVal FileName As String, ByVal FirstSearchWordFound As String)
Public Event FindFilesDone(ByRef ReturnList As Collection)
Public Event FindFilesCancel(ByRef CancelFind As Boolean)
 
Public Sub FindStrInDir(ByRef ReturnList As Collection, ByVal Root As String, ByVal Recurse As Boolean, _
                        ByVal FileTypes As String, ByVal StrFileSize As String, ByVal Attributes As VbFileAttribute, _
                        ByVal Compare As VbCompareMethod, ParamArray StrToFind() As Variant)
    
    Dim LOSize As Long, HISize As Long, K As Long
    Dim FTypes() As String, SFindCol As New Collection, SFind() As String
    
    FTypes = Split(FileTypes, ";") ' file types are delimited by ";", example "*.txt;*test*.dat;*.html;*blah blah*.htm"
    FlattenParamArrayToString SFindCol, StrToFind
    
    If SFindCol.Count > 0 Then
        ReDim SFind(SFindCol.Count - 1)
        
        For K = 0 To UBound(SFind)
            SFind(K) = SFindCol(1)
            SFindCol.Remove 1
        Next K
    Else
        ReDim SFind(0)
    End If
    
    If Attributes = 0 Then Attributes = vbDirectory + vbReadOnly + vbSystem + vbArchive + vbHidden
    'If Compare = 0 Then Compare = vbBinaryCompare   '  vbBinaryCompare IS 0 ...
    
    ' Get Low and High boundries for the file size to find
    If Len(StrFileSize) = 0 Then
        LOSize = 0
        HISize = 0
    Else
        K = InStr(1, StrFileSize, "-")
        
        If K > 0 Then
            LOSize = Val(Left(StrFileSize, K - 1))
            HISize = Val(Mid(StrFileSize, K + 1))
        Else
            LOSize = 0
            HISize = Val(StrFileSize)
        End If
    End If
    
    ' replace "/" with "\"  (just in case)
    If InStr(1, Root, "/") > 0 Then Root = Replace(Root, "/", "\")
    
    ' if recurse, list directories also
    If Recurse Then Attributes = Attributes Or vbDirectory
    
    FindStrInDirRecurse ReturnList, Root, Recurse, FTypes, LOSize, HISize, Attributes, Compare, SFind
    
    RaiseEvent FindFilesDone(ReturnList)
End Sub
 
Private Sub FlattenParamArrayToString(RetList As Collection, ParamArray Arr() As Variant)
    Dim K As Long, Q As Long, Str() As String, StrVal As String
    
    On Error Resume Next
    
    For K = LBound(Arr(0)) To UBound(Arr(0))
        If (VarType(Arr(0)(K)) And vbArray) = vbArray Then
            For Q = LBound(Arr(0)(K)) To UBound(Arr(0)(K))
                
                If (VarType(Arr(0)(K)(Q)) And vbArray) = vbArray Then
                    FlattenParamArrayToString RetList, Arr(0)(K)(Q)
                Else
                    StrVal = CStr(Arr(0)(K)(Q))
                    
                    If Err.Number <> 0 Then
                        Err.Clear
                    Else
                        If Len(Trim(StrVal)) > 0 Then RetList.Add StrVal
                    End If
                End If
            Next Q
        Else
            StrVal = CStr(Arr(0)(K))
            
            If Err.Number <> 0 Then
                Err.Clear
            Else
                If Len(Trim(StrVal)) > 0 Then RetList.Add StrVal
            End If
        End If
    Next K
End Sub
 
Private Function FindStrInDirRecurse(ByRef ReturnList As Collection, ByVal Root As String, ByVal Recurse As Boolean, _
                                FileTypes() As String, ByVal LOSize As Long, ByVal HISize As Long, ByVal Attributes As VbFileAttribute, _
                                Compare As VbCompareMethod, StrToFind() As String) As Boolean
    
    Dim DirX As String, K As Long, Dirs As New Collection, FF As Integer, FileData As String
    Dim FileSize As Long, CancelFind As Boolean
    
    ' make sure we have "\" at the end of directory
    If Right(Root, 1) <> "\" Then Root = Root & "\"
    
    On Error GoTo ExitFunction
    
    ' find first file, if error here, just exit function
    DirX = Dir(Root & "*.*", Attributes)
    
    RaiseEvent FindFilesCurrentDir(Root)
    
    ' loop until nothing is found
    Do Until Len(DirX) = 0
        If DirX <> "." And DirX <> ".." Then
            On Error Resume Next ' I tried with "On Error GoTo ..." but it does not work for some reason for file "pagefile.sys"
            
            If (GetAttr(Root & DirX) And vbDirectory) = vbDirectory Then ' if directory, add it to our list
                If Err.Number <> 0 Then GoTo NextFile
                
                If Recurse Then Dirs.Add DirX
            Else
                On Error GoTo NextFile
                
                FileSize = FileLen(Root & DirX)
                
                ' check file size
                If (LOSize = 0 And HISize = 0) Or (FileSize >= LOSize And FileSize <= HISize And FileSize > 0) Then
                    ' check file type
                    For K = 0 To UBound(FileTypes)
                        If DirX Like FileTypes(K) Then Exit For
                    Next K
                    
                    If K <= UBound(FileTypes) Then
                        If UBound(StrToFind) = 0 And Len(StrToFind(0)) = 0 Then
                            K = 0 ' don't search in file (search string array is empty)
                        Else
                            FF = FreeFile
                            
                            ' get file data
                            Open Root & DirX For Binary Access Read As FF
                                FileData = String(LOF(FF), 0)
                                Get FF, , FileData
                            Close FF
                            
                            ' find string(s) in the file
                            For K = 0 To UBound(StrToFind)
                                If InStr(1, FileData, StrToFind(K), Compare) > 0 Then Exit For
                            Next K
                        End If
                        
                        ' if passed ALL the tests, and the file to return list
                        If K <= UBound(StrToFind) Then
                            ReturnList.Add Root & DirX
                            RaiseEvent FindFilesFound(Root, DirX, StrToFind(K))
                        End If
                    End If
                End If
            End If
        End If
        
NextFile: ' for some system files like "hiberfil.sys" or "pagefile.sys" it will return error when you try to access it
        
        If Err.Number <> 0 Then Err.Number = 0
        
        RaiseEvent FindFilesCancel(CancelFind)
        
        If CancelFind Then
            FindStrInDirRecurse = False
            Exit Function
        End If
        
        DirX = Dir
    Loop
    
    On Error GoTo 0
    
    If Recurse Then
        Do While Dirs.Count > 0
            ' recurse through all dirs found in this directory
            
            If FindStrInDirRecurse(ReturnList, Root & Dirs(1), True, FileTypes, LOSize, HISize, Attributes, Compare, StrToFind) Then
                Dirs.Remove 1
            Else
                FindStrInDirRecurse = False
                Exit Function
            End If
        Loop
    End If
    
ExitFunction:
    FindStrInDirRecurse = True
End Function

[|2eM!x]

wow thats nuts, and thankyou manavo for that interesting fact

[Inuyasha1782]

Whoa! Thats a huge difference in size. Nice though, prob will make use of it soon in my next program.

[|2eM!x]

yep its some good code

[Justa Lol]

this code doesnt work to well, if i search once i need to close the program and run it again to search again.

anyways i like it, im good with restarting..

somehow it goes only through like 50 files?? how can i make it go through 100k?

[CVMichael]

To what code are you refering too ? |2eM!x or mine ?

[Justa Lol]

|2eM!x's code.

[CVMichael]

His code checks files only in directory specified, without going into subdirectories. So maybe that's why you may think it does not check all your files ?

You should see my code too (see the attachment)

[Justa Lol]

nah i have no sub directories, only over 10000 files in 1 directory, and when i search it gives me an error "to many files."

[CVMichael]

At what line ?

[Justa Lol]

i used your code too, it goes through 100 files then stops.

[CVMichael]

Well, if you don't tell us more details, I don't see how we can help you

Good luck on finding the problem

[Edgemeal]

nah i have no sub directories, only over 10000 files in 1 directory, and when i search it gives me an error "to many files."

Too many open files maybe? I don't see any close command in that code, try closing the file after the input.

Open mypath & p For Binary As #ff
strbuff = Input(LOF(ff), ff)
Close #ff