Search String in Text Files

[swaggerbox]

I have a macro that searches for a particular string in multiple text files in a folder and if it finds a match, copies the file to another location. The code below simply just that. How do I modify this code so that IT COPIES THE FILES that do NOT match the search string?

Sub StringExistsInFile()
    Dim theString As String
    Dim path As String
    Dim StrFile, NewFile As String
    Dim fso As New FileSystemObject
    Dim file As TextStream
    Dim line As String


    theString = "<DWG> 0/0"
    path = "C:\MyData\"
    StrFile = Dir(path & "*.txt")


    Do While StrFile <> ""


        Set file = fso.OpenTextFile(path & StrFile)
        Do While Not file.AtEndOfLine
            line = file.ReadLine
            If InStr(1, line, theString, vbTextCompare) > 0 Then
            
            FileCopy path & StrFile, "C:\MyData\1_TIF\" & StrFile
            
            Exit Do
            Else
                
            End If
        Loop


        file.Close
        Set file = Nothing
        Set fso = Nothing


        StrFile = Dir()
    Loop
End Sub

[snb]

Sub M_snb() 
  c00 = "C:\MyData\" 
  c01= Dir(c00 & "*.txt") 
     
  with createobject("scripting.filesystemobject")        
    Do While c01 <> "" 
      if instr(.opentextfile(c00 & c01).readall,"<DWG> 0/0")=0 then filecopy c00 & c01 ,"C:\MyData\1_TIF\" & c01
      c01=dir
    Loop 
  end with
End Sub

NB. You should adapt your posted macro according to the principles I used in this one.

[swaggerbox]

wow, this is great snb!

[swaggerbox]

Another question: Why do I get a permission denied error when I change the path to values on an excel sheet. See sample code below:

Sub M_snb()
Dim destPath As String


    c00 = Sheets("Sheet1").Range("B5").Value
    c01 = Dir(c00 & "*.txt")
     
    destPath = Sheets("Sheet1").Range("B8").Value
     
    With CreateObject("scripting.filesystemobject")
        Do While c01 <> ""
            If InStr(.OpenTextFile(c00 & c01).ReadAll, "<DWG> 0/0") = 0 Then FileCopy c00 & c01, destPath & c01
            c01 = Dir
        Loop
    End With
    
End Sub

[snb]

The file probably exists already or you forgot to end the path with a backslash \

Sub M_snb
    sn = Sheets("Sheet1").Range("B5:B6") 
    c01 = Dir(sn(1,1) & "*.txt") 
     
    With CreateObject("scripting.filesystemobject") 
        Do While c01 <> "" 
            If InStr(.OpenTextFile(sn(1,1) & c01).ReadAll, "<DWG> 0/0") = 0 Then FileCopy sn(1,1) & c01, sn(2,1) & c01 
            c01 = Dir 
        Loop 
    End With 
End Sub

[swaggerbox]

thanks again snb

[haribole]

For me it is not working !! Please help !!

    Dim TransId As String
    Dim Path As String
    Dim FileName As String
    Dim fso As New FileSystemObject
    Dim i As Integer
    i = 1
        TransId = "A0000000000425997"
        Path = "D:\SearchTransaction_FSO\"
        FileName = Dir(Path & "*.txt")
            With CreateObject("scripting.filesystemobject")
                Do While FileName <> ""
                  If InStr(.OpenTextFile(Path & FileName).ReadAll, TransId) = 0 Then
                             Worksheets(1).Cells(i + 1, 1) = i
                             Worksheets(1).Cells(i + 1, 2) = TransId
                             Worksheets(1).Cells(i + 1, 3) = Replace(FileName, ".txt", "")
                             i = i + 1
                    End If
                 FileName = Dir
                Loop
            End With