none
Search for text in large files without Carriage Return Characters more quickly RRS feed

  • Question

  • I have written code to search for text in text files. They have the extension .DAT

    The code works by:

    1. Locating files in a diectory that wre created of modified in a certain period
    2. Searching for a pair of string in each line
    3. if the strings are both found, then the name of the text file as well as the complete line is written in excel

    Is there anyway to improve the speed for the code? also can i put in a progress bar on approximately how far the process has gone?

    The code:

    Sub LoopThroughFiles()
    Range("3:1000000").Clear
    Application.ScreenUpdating = False
        Dim StrFile As String 'This is is the name of the File
        Dim Path As String 'Directory of the file
        Dim x As String 'Full path of the string
        
        Dim LastDate As Date 'The Maximum Date to compare with date modified
        Dim DateModified As Date 'Date when the file was created or modified
        Dim FirstDate As Date 'The minimum date to compare with Date Modified
        
        Dim fso As New FileSystemObject
        Dim file As TextStream
        
        Dim textline As String 'Text in each line in the file
        Dim SearchString As String 'String to search for
        Dim SearchString1 As String 'Second string to search for
        Dim y As Long 'Counter used to insert text in excel
        
        
        'Assign values to Variables
        Path = "\\omlac-011\COMPEN AUDIT TRAIL NEW ENVIRONMENT\"
        StrFile = Dir(Path & "BM*.DAT")
        
        
        FirstDate = CDate(Range("A1"))
        LastDate = CDate(Range("B1"))
        y = 1
        SearchString = Range("c1").Value
        SearchString1 = Range("D1").Value & vbTab
       
        Do While Len(StrFile) > 0
            x = Path & StrFile
            DateModified = CDate(FileDateTime(x))
            If DateModified > FirstDate And DateModified < LastDate Then
            Set file = fso.OpenTextFile(x, ForReading)
            
                Do While Not file.AtEndOfLine
                    textline = file.ReadLine
                    If InStr(1, textline, SearchString, vbTextCompare) > 0 And InStr(1, textline, SearchString1, vbTextCompare) > 0 Then
                        Range("A" & y + 2).Value = StrFile
                        Range("B" & y + 2).Value = textline
                        y = y + 1
                    End If
                Loop
                
                file.Close
                Set file = Nothing
                Set fso = Nothing
            End If
            StrFile = Dir()
         
        Loop
        
    
    Range("B3").Select
        Range(Selection, Selection.End(xlDown)).Select
     On Error Resume Next
     
        Selection.TextToColumns Destination:=Range("B3"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False
            
    Application.ScreenUpdating = True
    
    End Sub

    Thursday, October 9, 2014 9:50 AM

Answers

All replies