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