VB Script to Copy lines from text file containing Keyword - vbscript

Question

VB Script to Copy lines from text file containing Keyword "Failed". I have a script I am editing that has, so far only been able to copy only instance if the failed lines. In this case, the file only has 2 lines that need to be logged but the are over 12,000 total successful lines. Example below.
1111 ,1 ,xxxx ,xxxx ,1 ,10/01/2022 ,07/29/2022 ,1111 ,200 , , , , , ,Failed, , An error occurred while updating the entries. See the inner exception for details ,
2222 ,2 ,xxxxo ,Kxxxx ,2 ,10/01/2022 ,07/29/2022 ,2222 ,0 , , , , , ,Successfully imported, , ,
33333 ,3 ,Uxxxx ,Jxxxx ,1 ,07/25/2022 ,07/29/2022 ,3333 ,200 , , , , , ,Failed, , An error occurred while updating the entries. See the inner exception for details ,
The current script creates blank lines for the successful lines and only logs the 1 failed line. Trying to get this to all lines containing Failed.
Here is what I am working with.
Option Explicit
Dim StdIn: Set StdIn = WScript.StdIn
Dim StdOut: Set StdOut = WScript
Main()
Sub Main()
Dim objFSO, filepath, objInputFile, tmpStr, ForWriting, ForReading, count, text, objOutputFile, index, LOGFILE, foundFirstMatch
Set objFSO = CreateObject("Scripting.FileSystemObject")
LOGFILE = "c:\New folder\Errorlog.csv"
ForReading = 1
ForWriting = 2
Set objInputFile = objFSO.OpenTextFile(LOGFILE, ForReading, False)
text="Fail"
foundFirstMatch = false
Do until objInputFile.AtEndOfStream
tmpStr = objInputFile.ReadLine
If foundStrMatch(tmpStr)=true Then
If foundFirstMatch = false Then
index = getIndex(tmpStr)
foundFirstMatch = true
text = text & vbCrLf & textSubstitution(tmpStr,index,"true")
End If
If index = getIndex(tmpStr) Then
text = text & vbCrLf & textSubstitution(tmpStr,index,"false")
ElseIf index < getIndex(tmpStr) Then
index = getIndex(tmpStr)
text = text & vbCrLf & textSubstitution(tmpStr,index,"true")
End If
Else
text = text & vbCrLf & textSubstitution(tmpStr,index,"false")
End If
Loop
Set objOutputFile = objFSO.CreateTextFile("C:\New folder\Log2.txt", ForWriting, true)
objOutputFile.Write(text)
End Sub
Function textSubstitution(tmpStr,index,foundMatch)
'Dim strToAdd
'strToAdd = "<tr><td>Beginning_of_CF5.0_Features_TC" & CStr(index) & "</td></tr>"
'If foundMatch = "false" Then
'textSubstitution = tmpStr
If foundMatch = "true" Then
textSubstitution = tmpStr
End If
End Function
Function getIndex(tmpStr)
Dim substrToFind, charAtPos, char1, char2
substrToFind = "Failed"
charAtPos = len(substrToFind) + 1
char1 = Mid(tmpStr, charAtPos, 1)
char2 = Mid(tmpStr, charAtPos+1, 1)
'If IsNumeric(char2) Then
'getIndex = CInt(char1 & char2)
'Else
'getIndex = CInt(char1)
'End If
End Function
Function foundStrMatch(tmpStr)
Dim substrToFind
substrToFind = "Failed"
If InStr(tmpStr, substrToFind) > 0 Then
foundStrMatch = true
Else
foundStrMatch = false
End If
End Function

Answer 1

You should write matched lines as you find them, like this:
Set objFSO = CreateObject("Scripting.FileSystemObject")
LOGFILE = "c:\New folder\Errorlog.csv"
OUTFILE = "C:\New folder\Log2.txt"
ForReading = 1
ForWriting = 2
Set objInputFile = objFSO.OpenTextFile(LOGFILE, ForReading, False)
Set objOutputFile = objFSO.CreateTextFile(OUTFILE, ForWriting, true)
text="Fail"
Do until objInputFile.AtEndOfStream
tmpStr = objInputFile.ReadLine
If InStr(tmpStr,text)>0 Then objOutputFile.WriteLine(tmpStr)
Loop
objInputFile.Close
objOutputFile.Close