I have a file in which I am able to find the keyword using vbscript but further I need to keep copying next 3-4 lines down it, until I find another occurrence of similar pattern of keyword.
I have written something like this - ( I am newbee for assume I am dumb )
Set fso = CreateObject("Scripting.FileSystemObject")
Set inFile = fso.OpenTextFile("FileName", 1)
Set outFile = fso.OpenTextFile("FileName", 8, True)
outFile.WriteLine("This is some sample data.")
strAnswer = InputBox("Please enter a value:", _
"Enter Value")
Do until inFile.AtEndOfStream
line = inFile.ReadLine
If InStr(line, strAnswer) Then
outFile.WriteLine line ' Copy the line and write to output file
serNum = Left(line, 7)
'If Not ((line = inFile.ReadLine())
'take first 3 char and find the next occurance of it
'copy all lines until that line
WScript.Echo "Found"
End If
Loop
outfile.Close
Set fSO = Nothing
Any suggestion is appreciable.
You could use a sub-loop to continue writing until the serial number is found again.
Do until inFile.AtEndOfStream
line = inFile.ReadLine
If InStr(line, strAnswer) Then
outFile.WriteLine line ' Copy the line and write to output file
serNum = Left(line, 7)
' Continue writing until EOF or serial number is found...
Do While Not inFile.AtEndOfStream
line = inFile.ReadLine
If InStr(line, serNum) = 0 Then outFile.WriteLine line
Loop
End If
Loop
Use the state of the variable serNum to decide what you need to do with the current line:
Do until inFile.AtEndOfStream
line = inFile.ReadLine
If Not IsEmpty(serNum) And InStr(line, serNum) > 0 Then WScript.Quit
If IsEmpty(serNum) And InStr(line, strAnswer) > 0 Then serNum = Left(line, 7)
If Not IsEmpty(serNum) Then outFile.WriteLine line
Loop
The first condition checks if you have found the second match and then quits.
The second condition checks if you have found the first match and then initializes serNum.
The third condition causes all lines from the first match to the line before the second match to be written to the output file.
Related
In a text file consisting of thousands of records, each having greater than 20 lines of data, I need to count the 14th line after the start of every record if that 14th line is blank. The line is either blank or contains a date.
The start of every record is the same: "1 Start of new record"
Scenario:
1 Start of new record
2 some data
3 "
4 "
5 "
6 "
7 "
8 "
9 "
10 "
11 "
12 "
13 "
14
...
1 Start of new record
...
8 "
9 "
10 "
...
14 10/19/2019
...
In this simple scenario, the result should be 1. I have code that copies line 1 of every record into a second file.
The result obviously being:
1 Start of new record
1 Start of new record
...
Here is the code I have:
Const ForReading = 1
Dim words(1)
Dim msg
words(0) = "1 Start of New Record"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set inFile = objFSO.OpenTextFile("c:\Temp\altest.txt", ForReading)
Set outFile = objFSO.OpenTextFile("c:\Temp\altest_output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
WScript.Echo "Done!"
This seems like a good start, but again, I need to count the 14th line after the start of every record if that 14th line is blank.
Any help is greatly appreciated.
-Alel
Hardly elegant but something like this should get you on your way. This doesn't use SkipLine, it just marks the next line of interest:
Option Explicit 'force explicit variable declaration, this is just good practice
Const ForReading = 1
Dim strContent
Dim Offset : Offset = 14 'define the 14th 'line'
Dim StartLine
Dim NewRecordMarker : NewRecordMarker = "1 Start of new record" 'just use a string to match
Dim objFSO, inFile, outFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set inFile = objFSO.OpenTextFile("e:\Temp\altest.txt", ForReading)
Set outFile = objFSO.OpenTextFile("e:\Temp\altest_output.txt", 8, True)
'notice we're only reading forward
'that means we can set the next LineOfInterest without having to worry about
'exceeding AtEndOfStream like we would if we'd use SkipLine
'this is just simpler.
'this obviously falls apart when the line of interest is NOT the 14th line
Do Until inFile.AtEndOfStream
Dim LineOfInterest
strContent = inFile.ReadLine 'inFile.Line will at 2 at this point because we just read it
If strContent = NewRecordMarker Then 'found a new record, we want to look 14 lines from here
LineOfInterest = inFile.line - 1 + Offset ' -1 or we'll overshoot our target
End If
If inFile.Line = LineOfInterest Then 'this is the line we want to inspect
outFile.WriteLine strContent 'just write out entire value, no checking for date here
End If
Loop
inFile.Close
outFile.Close
WScript.Echo "Done!"
I have pieced together a script that is working, but not 100%.
I am reading values from a file (A) and then searching in a specific position in another file (B) for a match, then writing the entire row of data to a new file (C).
The script below works great on reading the first row in the data (file A), but it won't get past the first row.
Here is a sample list of strings I am searching for from file (A).
9899008KT2018012600000444
9899008KT2018012600000445
Here is my script:
Set fso = CreateObject("Scripting.FileSystemObject")
Set inFile = fso.OpenTextFile("C:\JeffTestFolder\9899008KT2018012600.txt", 1)
Set outFile = fso.OpenTextFile("C:\TestFolder\9899008KT2018012600_Compiled.txt", 8, True)
Set listFile = fso.OpenTextFile("C:\TestFolder\ListOfIDs.txt", 1)
Do Until listFile.AtEndOfStream
fName = listFile.ReadLine
Do Until inFile.AtEndOfStream
line = inFile.ReadLine
If Mid(line, 7, 25) = fName Then outFile.WriteLine line
Loop
Loop
I am stuck on how to get it to Loop and read the next line in file (A) then go search for that value in file (B) and write it to the new file (C).
If you want to compare each line of A against each line of B you need to repeat reading B for each line of A:
Do Until listFile.AtEndOfStream
fName = listFile.ReadLine
Set inFile = fso.OpenTextFile("C:\JeffTestFolder\9899008KT2018012600.txt")
Do Until inFile.AtEndOfStream
line = inFile.ReadLine
If Mid(line, 7, 25) = fName Then outFile.WriteLine line
Loop
inFile.Close
Loop
or read the entire file into an array or dictionary and use that array/dictionary as the reference:
txt = fso.OpenTextFile("C:\JeffTestFolder\9899008KT2018012600.txt").ReadAll
arr = Split(txt, vbNewLine)
Do Until listFile.AtEndOfStream
fName = listFile.ReadLine
For Each line In arr
If Mid(line, 7, 25) = fName Then outFile.WriteLine line
Next
Loop
Set dict = CreateObject("Scripting.Dictionary")
txt = fso.OpenTextFile("C:\JeffTestFolder\9899008KT2018012600.txt").ReadAll
For Each line In Split(txt, vbNewLine)
dict(Mid(line, 7, 25)) = True
Next
Do Until listFile.AtEndOfStream
fName = listFile.ReadLine
If dict.Exists(fName) Then outFile.WriteLine line
Loop
Which one to pick depends on file size and system resources. The second and third approach provide better performance, because they avoid repeated disk I/O, but may lead to memory exhaustion when the file is large.
I would like to read a specific line in a .txt file in a vb 6.0 program. My intrest is where a particular line where a certain text appears. I am trying to apply this code which I got from another project.
Dim strLine As String
Open "E:\Projects\VB\Ubunifu\MyList.txt" For Input As #1
Line Input #1, strLine ' read one line at a time vs entire file
lblCurrent.Caption = strLine
Line Input #1, strLine
lblO.Caption = strLine
Close #1
however this doesnt seem to be working it says "input past end of file"
You can try this:
Private Sub Form_Load()
Text1.MultiLine = True
Open "E:\Projects\VB\Ubunifu\MyList.txt" For Input As #1
Text1.Text = Input$(LOF(1), #1)
lblCurrent.Caption = udf_ReadLine(Text1.Text, 1) ' read line #1
lblCurrent_i.Caption = udf_ReadLine(Text1.Text, 2) ' read line #2
Close #1
End Sub
Private Function udf_ReadLine(ByVal sDataText As String, ByVal nLineNum As Long) As String
Dim sText As String, nI As Long, nJ As Long, sTemp As String
On Error GoTo ErrHandler
sText = ""
nI = 1
nJ = 1
sTemp = ""
While (nI <= Len(sDataText))
Select Case Mid(sDataText, nI, 1)
Case vbCr
If (nJ = nLineNum) Then
sText = sTemp
End If
Case vbLf
nJ = nJ + 1
sTemp = ""
Case Else
sTemp = sTemp & Mid(sDataText, nI, 1)
End Select
nI = nI + 1
Wend
If (nJ = nLineNum) Then
sText = sTemp
End If
udf_ReadLine = sText
Exit Function
ErrHandler:
udf_ReadLine = ""
End Function
I just added a function to read line from a string, and you can keep using the LOF function as you wish, also all of the concept from your original code.
First, if you had searched for your error you would have found the cause, https://msdn.microsoft.com/en-us/library/aa232640(v=vs.60).aspx.
Second, you need to do something to ensure there is anything in the file to read. https://msdn.microsoft.com/en-us/library/aa262732(v=vs.60).aspx
Finally, use a loop to read lines from the file. It appears you want the first line displayed in one label and the second line displayed in another. The code below reads one line at a time from the file, decides if it is reading an odd line number (first line) or even line number (second line) and displays the line in the label. After each line is read it looks for "a certain text" whatever that may be, and if found it exits the loop and closes the file.
Open "E:\Projects\VB\Ubunifu\MyList.txt" For Input As #1
Do While EOF(1) = False
Line Input #1, strLine ' read one line at a time vs entire file
lngLineNum = lngLineNum + 1 'Am I reading an odd or even line number
If lngLineNum Mod 2 <> 0 Then
lblCurrent.Caption = strLine
Else
lblO.Caption = strLine
End If
If InStr(1, strLine, "a cetain text", vbTextCompare) > 0 Then
Exit Do
End If
Loop
Close #1
Note that I did not check that strLine contained anything before calling InStr. If it is empty the InStr function will cause an error. You should add some defensive coding. At the very least an error handler.
I got this code which deletes 10 lines starting from the top.
Is it possible to do the same but starting the delete from the bottom to the top of the txt file?
So if I have 30 lines, I want the last 10 or 20 lines to be deleted.
Const FOR_READING = 1
Const FOR_WRITING = 2
strFileName = "C:\scripts\delete.txt"
iNumberOfLinesToDelete = 10
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(strFileName, FOR_READING)
strContents = objTS.ReadAll
objTS.Close
arrLines = Split(strContents, vbNewLine)
Set objTS = objFS.OpenTextFile(strFileName, FOR_WRITING)
For i=0 To UBound(arrLines)
If i > (iNumberOfLinesToDelete - 1) Then
objTS.WriteLine arrLines(i)
End If
Next
If you read the entire file into an array of lines you'd use more or less the same approach for removing lines from beginning or end.
To remove lines from the beginning you start at an offset after the lines that you want removed:
filename = "C:\path\to\your.txt"
numLinesToRemove = 10
Set fso = CreateObject("Scripting.FileSystemObject")
txt = Split(fso.OpenTextFile(filename).ReadAll, vbNewLine)
Set f = fso.OpenTextFile(filename, 2)
For i = numLinesToRemove To UBound(txt)
f.WriteLine txt(i)
Next
f.Close
To remove lines from the end of the file you stop before the lines that you want removed:
filename = "C:\path\to\your.txt"
numLinesToRemove = 10
Set fso = CreateObject("Scripting.FileSystemObject")
txt = Split(fso.OpenTextFile(filename).ReadAll, vbNewLine)
Set f = fso.OpenTextFile(filename, 2)
For i = 0 To UBound(txt) - numLinesToRemove
f.WriteLine txt(i)
Next
f.Close
This approach only works for small files, though. If you need to process large files you usually can't read the entire file into memory. If you did your computer would start swapping data from memory to disk, causing the system to slow down to a crawl. To avoid this you normally read the file line by line in a loop and write to a temporary file, then replace the original file with the temp file after processing is complete.
Removing lines from the beginning of a file is still fairly trivial, because TextStream objects have a Line property that holds the current line number (i.e. the number of the line that the next ReadLine call would read).
Set f = fso.OpenTextFile(filename)
Set tmp = fso.OpenTextFile(filename & ".tmp", 2, True)
Do Until f.AtEndOfStream
If f.Line <= numLinesToRemove Then
f.SkipLine
Else
tmp.WriteLine f.ReadLine
End If
Loop
f.Close
tmp.Close
However, you can't do that for removing lines from the end of the file, because you don't know the number of lines beforhand. One way to deal with this is to create a ring buffer the size of the number of lines you want to remove, fill it as you read lines from the input file, and write lines to the output file when they are removed from the buffer. That way the last numLinesToRemove lines are still in the buffer (not written to the output file) when the loop terminates.
ReDim buf(numLinesToRemove) 'ring buffer
i = -1 'ring buffer pointer
Set f = fso.OpenTextFile(filename)
Set tmp = fso.OpenTextFile(filename & ".tmp", 2, True)
Do Until f.AtEndOfStream
i = (i + 1) Mod numLinesToRemove 'advance ring buffer pointer
'if current buffer slot is filled write it to the output file ...
If Not IsEmpty(buf(i)) Then tmp.WriteLine buf(i)
'... then put current line from input file into current buffer slot
buf(i) = f.ReadLine
Next
f.Close
tmp.Close
In both cases you'd replace the original file after processing is complete, e.g. like this:
fso.DeleteFile filename
fso.MoveFile filename & ".tmp", filename
just loop backwards in your for statement
For i=UBound(arrLines) To (UBound(arrLines) -10) step -1
Next
I'm trying to make a script that we can output a specific string ino a files from a list of files in different subfolders.
My script works but onl for one directory. I need some help to make it works with subfolders
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set folder = objFSO.GetFolder("D:\vbs\logs\") ' here i have loads of subfolders with *.txt
Set outfile = objFSO.CreateTextFile("D:\vbs\ok\test.txt") ' my output file
for each file in folder.Files
Set testfile = objFSO.OpenTextFile(file.path, ForReading)
Do While Not testfile.AtEndOfStream
If instr (testfile.readline, "central") then ' i output every lines where there is the word "central"
outfile.writeline testfile.readline
End If
if instr (testfile.readline, "version") then ' i use this to parse my output file to get a indication between every files read
num = testfile.readline
mag = Split(num)
elseif testfile.AtEndOfStream = true then
outfile.writeline "Shop " & mag(4)
end if
Loop
testfile.close
next
outfile.close
See this answer to a similar question for a folder recursion example.
One remark about your existing code, though: each call of the ReadLine method reads the next line from the file, so something like this:
If instr (testfile.readline, "central") then
outfile.writeline testfile.readline
End If
will not output the line containing the word "central" (as your comments say), but the line after that line.
If you want to output the line containing the word you're checking for, you have to store the read line in a variable and continue with that variable:
line = testfile.ReadLine
If InStr(line, "central") Then
outfile.WriteLine line
End If
I would encapsulate your entire For...Each block into a new subroutine and then add a new For...Each block to capture all subFolders in the parent folder. I added that functionality to your script, see below.
Const ForReading = 1
Const Start_Folder = "D:\vbs\logs\" ' here i have loads of subfolders with *.txt
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set outfile = objFSO.CreateTextFile("D:\vbs\ok\test.txt") ' my output file
'Call the Search subroutine to start the recursive search.
Search objFSO.GetFolder(Start_Folder)
'Close the outfile after all folders have been searched
outfile.Close
Sub Search(sDir)
for each file in sDir.Files
Set testfile = objFSO.OpenTextFile(file.path, ForReading)
Do While Not testfile.AtEndOfStream
If instr (testfile.readline, "central") then ' i output every lines where there is the word "central"
outfile.writeline testfile.readline
End If
if instr (testfile.readline, "version") then ' i use this to parse my output file to get a indication between every files read
num = testfile.readline
mag = Split(num)
elseif testfile.AtEndOfStream = true then
outfile.writeline "Shop " & mag(4)
end if
Loop
testfile.close
next
'Find EACH SUBFOLDER.
For Each subFolder In sDir.SubFolders
'Call the Search subroutine to start the recursive search on EACH SUBFOLDER.
Search objFSO.GetFolder(subFolder.Path)
Next
End Sub