I understand that the FSO does not know to read the lines from the last in a file.
My scenario here is to validate the last but 1 line and get the result out of it.
Assume, if i need to get the result as PASS or FAIL in the last but 1 line. Since i go through from the first line, the scenario of me getting the correct result is limited because there is a probability of PASS or FAIL appearing in the file earlier.
My last 2 lines in the file is
Failed
Done!!!!
OR
Passed
Done!!!!
to get the actual i am using a NESTED IF validation to get the result. Below is the snippet of the same.
str1 = "Passed"
str2 = "Failed"
str3="Done!!!!"
Do Until objFile.AtEndOfStream
str=objFile.ReadLine
if StrComp(str, str1) = 0 Then
str=objFile.ReadLine
if StrComp(str,str3) = 0 Then
result="PASS"
End if
elseif StrComp(str, str2) = 0 Then
str = objFile.ReadLine
if StrComp(str,str3) = 0 Then
result="FAIL"
End if
End if
Loop
This affects the performance. Is there any alternative to get this implementation in a better manner?
Here is a function which takes a file name and returns the second to last line read:
Function PenultimateLine(fname)
Dim fso, ts, line1, line2
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(fname)
Do Until ts.AtEndOfStream
line1 = line2
line2 = ts.ReadLine
Loop
ts.Close
PenultimateLine = line1
End Function
You can use this function to extract the line and then test it against "PASS" or "FAIL" (which, by the way, can be done simply with = rather than StrCmp)
A = Split(objfile.readall, vbcrlf)
B = A(ubound(A)-2)
This uses memory and is unsuitable on very large files.
Related
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.
The application converts Excel files to txt. I have to verify each line matches. Below is the function to verify that, but the problem is it sometimes returns empty string from txt file or excel file, while both files have text in those rows/lines.
I get file and folder names, as well as what excel sheet to use (as TabUse) from database
Function excelcomparison (ByRef ObjFolder, ByRef OrgFolder, ByRef originalfile, ByRef targetFile, ByRef TabUse)
print originalfile&":::"&TabUse&" -=VS=- "&targetFile
Dim fsox : Set fsox = CreateObject("Scripting.FileSystemObject")
Dim TargFileRead : Set TargFileRead = fsox.OpenTextFile(targetFile)
Dim OrgExcel : Set OrgExcel = CreateObject("Excel.Application")
'Application.DisplayAlerts = False
OrgExcel.Workbooks.Open(originalfile)
Set vSheet = OrgExcel.ActiveWorkbook.WorkSheets(TabUse)
For rc = 1 To vSheet.UsedRange.Rows.Count
For cc = 1 To vSheet.UsedRange.Columns.Count
vtext = (vSheet.cells(rc,cc))
If vstring="" Then
vstring=vtext
Else
vstring = vstring&vbTab&vtext
End If
Next
"Trim" any leading and trailing tabs:
Do
If Left(vstring , 1)=ChrW(9) Then
vstring = MID(vstring, 2)
Else
Exit Do
End If
Loop
Do
If RIGHT(vstring, 1)=ChrW(9) Then
vstring= REPLACE(RIGHT(vstring, 1),ChrW(9), ChrW(32))
vstring=Trim(vstring)
Else
Exit Do
End If
Loop
vstring = Trim(vstring)
Some cells are united in Excel and have height of two or more row. So, skip those excel rows and txt lines:
If len(vstring)>0 Then
TargFileText = TargFileRead.ReadLine
Do
If Left(TargFileText, 1)=ChrW(9) Then
TargFileText = MID(TargFileText, 2)
Else
Exit Do
End If
Loop
Do
If RIGHT(TargFileText, 1)=ChrW(9) Then
TargFileText = REPLACE(RIGHT(TargFileText, 1),ChrW(9), ChrW(32))
TargFileText=Trim(TargFileText)
Else
Exit Do
End If
Loop
TargFileStr = Trim(TargFileText)
If trim(vstring) = trim(TargFileStr) Then
' print "match"
Else
print "Not Match"
print "+"&trim(TargFileStr)
print "*"&trim(vstring)
End If
Else
print "Lenth=0"
End If
vstring = ""
vtext = ""
TargFileStr=""
Next
OrgExcel.ActiveWorkbook.Close
TargFileRead.Close
fsox = Nothing
TargFileRead = Nothing
vSheet = Nothing
OrgExcel = Nothing
End Function
Problem 1: It does not read some text or excel files, randomly (returns empty string from excel/text file)
Problem 2: It does not close opened Excel and they take huge memory (up to 50 files to be verified)
Question: What needs to be fixed?
I think the problem is arising when you are trying to remove the vbtab from the Right end side of the string in both the excel and the text file.
For Excel, you have used:
If RIGHT(vstring, 1)=ChrW(9) Then
vstring= REPLACE(RIGHT(vstring, 1),ChrW(9), ChrW(32)) 'This may be the source of your problem
vstring=Trim(vstring)
Else
Exit Do
End If
Explanation:
You are replacing ChrW(9) with chrw(32) in a string[RIGHT(vstring, 1)] which contains nothing but chrw(9). After you have done this replacement, you are assigning the result[which is chrw(32) or a space] to the variable vstring. After this line, you trim this variable due to which vstring=""
For Text file you have used:
If RIGHT(TargFileText, 1)=ChrW(9) Then
TargFileText = REPLACE(RIGHT(TargFileText, 1),ChrW(9), ChrW(32)) 'This may be the source of the problem
TargFileText=Trim(TargFileText)
Else
Exit Do
End If
Explanation:
You are replacing ChrW(9) with chrw(32) in a string[RIGHT(TargFileText, 1)] which contains nothing but chrw(9). After you have done this replacement, you are assigning the result[which is chrw(32) or a space] to the variable TargFileText. After this line, you trim this variable due to which TargFileText=""
SOLUTION:
In both the cases, you need to remove the tab from the right side just like the way you removed vbTab from the left end side of the string i.e, by using the MID function:
If RIGHT(vstring, 1)=ChrW(9) Then
vstring= mid(vstring,1,len(vstring)-1) 'If there is a tab in the right side of the string, just capture till second last character of the string thus excluding the vbTab.
Else
Exit Do
End If
Similarly, for the text file:
TargFileText= mid(TargFileText,1,len(TargFileText)-1)
Also, you are reading the text file only when the vstring is not blank. So, if the vstring is blank, the text file "pointer" remains at the same line where as excel row increments by 1. Due to this, you may have incorrect comparisons. To avoid this, you can use Skipline method in the else part as shown below:
If len(vstring)>0 Then
'----your code----
'...
'...
else
TargFileRead.Skipline 'so that it skips the line corresponding to the case when vstring is ""
'--remaining code---
End If
For closing the excel, use the Quit method of the Excel application.
OrgExcel.Quit
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 am working on VB Script and I am trying to read the txt file and sore it in a array.
I check for the number of lines and use that variable for the For loop.
I am getting an error Input past end of the file.
I am not sure how to solve this problem.
looking forward for your help.
Thank you!!
Dim num As Integer
'Skip lines one by one
Do While objTextFile.AtEndOfStream <> True
objTextFile.SkipLine ' or strTemp = txsInput.ReadLine
Loop
num = objTextFile.Line - 1
Dim para()
ReDim para(num)
For i = 1 To num
para(i) = objTextFile.ReadLine
Next
For two reasons (the second coming intp play if you fix the first):
You have already read the file to the end. You would need to reset or reopen it.
You are always reading 125 lines, regardless of how many lines you found.
You can read the lines and put them in the array in one go:
Dim para()
Dim num As Integer = 0
Do While Not objTextFile.AtEndOfStream
ReDim Preserve para(num)
para(num) = txsInput.ReadLine
num = num + 1
Loop
Note: Arrays are zero based, and the code above places the first line at index 0. If you place the data from index 1 and up (as in the original code) you leave the first item unused, and you have to keep skipping the first item when you use the array.
Edit:
I see that you changed 125 to num in the code, that would fix the second problem.
I've used the following style code which is fast for small files:
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(strList, ForReading)
strText = objTextFile.ReadAll
objTextFile.Close
arrList = Split(strText, vbCrLf)
I hope that some brains out there can solve this frustrating puzzle for me.
The script (cobbled together from various bits from on the net) works perfectly when run by double clicking, the file to be split is hard coded.
When dragging and dropping the file onto the script, there is an error for 'File not found'
Please help!
I have tried the answer provided, but then the script runs without failure, but also does not output the three files as it does when 'textFile' value is hard coded.
if WScript.Arguments.Count <> 0 then
textFile = WScript.Arguments(0)
else
textFile = "multi2.txt"
end if
saveTo = ""
writeTo = ""
strNewLine = "%_N_"
headingPattern = "(%_N_)"
dim fileFrom, regex, fileTo
Set fso = CreateObject("Scripting.FileSystemObject")
set fileFrom = fso.OpenTextFile(textFile)
set regex = new RegExp
set fileTo = nothing
with regex
.Pattern = headingPattern
.IgnoreCase = false
.Global = true
end with
while fileFrom.AtEndOfStream <> true
line = fileFrom.ReadLine
set matches = regex.Execute(line)
if matches.Count > 0 then
strCheckForString = UCase("%")
strNewLine = "%_N_"
StrContents = Split(fso.OpenTextFile(textFile).ReadAll, vbNewLine)
If (Left(UCase(LTrim(line)),Len(strCheckForString)) = strCheckForString) Then
line = Right(line, len(line)-4)
line1 = Left(line, len(line)-4)
writeTo = saveTo & (line1 & ".arc")
if not(fileTo is nothing) then fileTo.Close()
set fileTo = fso.CreateTextFile(writeTo)
fileTo.WriteLine(strNewLine & line)
else
fileTo.WriteLine(line)
End If
else
fileTo.WriteLine(line)
end if
wend
fileFrom.Close()
set fileFrom = nothing
set fso = nothing
set regex = nothing
The text file looks like this:
%_N_160_SP01_MPF
;$PATH=/_N_WKS_DIR/_N_AFO160_WPD
blah blah blah
%_N_160_SP02_MPF
;$PATH=/_N_WKS_DIR/_N_AFO160_WPD
blah blah blah
%_N_160_SP99_MPF
;$PATH=/_N_WKS_DIR/_N_AFO160_WPD
blah blah blah
It looks like your code is supposed to extract the filename from the first argument:
textFile = Right(WScript.Arguments(0), len(WScript.Arguments(0))-44)
and then open the file using just the filename:
set fileFrom = fso.OpenTextFile(textFile)
OpenTextFile is looking for a relative path below the current working directory, unless it's provided with an absolute path. When you run the script by double-clicking it, the working directory is the folder from which you launch the script. When you drop a file onto the script, the working directory may be something entirely different.
If your input file is located in the same folder as the script, that would explain why it works when started via double-click, but not when dropping the file on the script. In the latter case the script would be looking for multi2.txt in the wrong place.
You can verify that by adding the following lines at the beginning of your script.
WScript.Echo CreateObject("WScript.Shell").CurrentDirectory
WScript.Echo CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
I suspect you'll get two different paths.
You can fix this issue by not removing the path from the argument. Change this:
if WScript.Arguments.Count <> 0 then
textFile = Right(WScript.Arguments(0), len(WScript.Arguments(0))-44)
'textFile = (chr(34) & textFile & chr(34))
else
textFile = "multi2.txt"
end if
into this:
If WScript.Arguments.Count <> 0 Then
textFile = WScript.Arguments(0)
Else
textFile = "multi2.txt"
End If
and the code should work as expected.