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
Related
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 have a script that reads in a comma delimited text file, however whenever I use Trim(str) on one of the values I have extracted in the file, it won't work...
My Text File:
some string, anotherstring, onelaststring
some string, anotherstring, onelaststring
some string, anotherstring, onelaststring
some string, anotherstring, onelaststring
My Script:
Dim fso, myTxtFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set myTxtFile = fso.OpenTextFile("mytxt.txt")
Dim str, myTxtArr
txtContents myTxtFile.ReadAll
myTxtFile.close
myTxtArr = Split(txtContents, vbNewLine)
For each line in myTxtArr
tLine = Split(tLine, ",")
Trim(tLine(1))
If tLine(1) = "anotherstring" Then
MsgBox "match"
End If
Next
My script never reaches "match" and I'm not sure why.
Trim() is a function that returns the trimmed string. Your code uses it improperly. You need to use the returned value:
myTxtArr(1) = Trim(myTxtArr(1))
or use another variable to store the value, and use that separate variable in the comparison,
trimmedStr = Trim(myTxtArr(1))
If trimmedStr = "anotherstring" Then
or you can just use the function return value directly in the comparison,
If Trim(myTxtArr(1)) = "anotherstring" Then
Here's a corrected version of that portion of your code:
For each line in myTxtArr
tLine = Split(line, ",")
tLine(1) = Trim(tLine(1))
If tLine(1) = "anotherstring" Then
MsgBox "match"
End If
Next
I have a folder that I will be looping through to process files differently based on their filenames. Doing good on my script (first one!), until I realized there will be filenames that have also have numbers representing priority. For example in the folder there may be:
'NV_CX67_mainx.dxf'
'NV_CX67_mainx1.dxf'
'NV_CX67_mainx2.dxf '
'NV_CX67_mainxroad.dxf'
'NV_CX67_motx.dxf'
'NV_CX67_resxroad.dxf'
The mainx, mainx1 and mainx2 are the same file type but mainx2 has priority and should be the only one processed. Currently, my statement is:
If Instr(1,FileRef, "mainx",1) then
How might I add a 2nd filter to process only the file with the highest number before moving onto the next file?
You are going to have run through the following process
Sort your input files
Loop through each file one by one
Compare the current file to the previous one you looked at minus the numbers to see if it greater.
Only process an item you have scanned all the similar items to ensure this one has the largest number
I wrote up an example below. Notice only NV_CX67_mainx4.dxf, and NV_CX67_mainxroad.dxf get processed:
Option Explicit
Dim i, sBaseFileName, sPrevFileName, prevBaseFile
sPrevFileName = "~"
prevBaseFile = "~"
Dim arr(5)
'Initialize test array. This will need to be sorted for this code to work properly
arr(0) = "NV_CX67_mainx.dxf"
arr(1) = "NV_CX67_mainx4.dxf"
arr(2) = "NV_CX67_mainx2.dxf"
arr(3) = "NV_CX67_mainxroad.dxf"
arr(4) = "NV_CX67_motx.dxf"
arr(5) = "NV_CX67_resxroad.dxf"
'Loop through the array
For i = LBound(arr) to UBound(arr)
If Instr(1, arr(i), "mainx",1) Then 'Check prev qualifier
sBaseFileName = getsBaseFileName(arr(i))
'First Case
If prevBaseFile = "~" Then
prevBaseFile = sBaseFileName
sPrevFileName = arr(i)
'Tie - Figure out which one to keep based on number at end of file name
ElseIf prevBaseFile = sBaseFileName Then
sPrevFileName = GetMaxFile(sPrevFileName, arr(i))
prevBaseFile = getsBaseFileName(sPrevFileName)
'New Case - Process prev case
Else
'Process File
MsgBox ("Processing " + sPrevFileName)
'Capture new current file for future processing
sPrevFileName = arr(i)
prevBaseFile = getsBaseFileName(sPrevFileName)
End If
End If
Next
'If last file was valid process it
If sPrevFileName <> "~" Then
MsgBox ("Processing " + sPrevFileName)
End If
'Return the larger of the two files based on numbers at end.
'Note "file9.txt" > "file10.txt" in this code
Function GetMaxFile(sFile1, sFile2)
GetMaxFile = sFile1
If sFile2 > sFile1 Then
GetMaxFile = sFile2
End If
End Function
'Return the file without extension and trailing numbers
'getsBaseFileName("hello123.txt") returns "hello"
Function getsBaseFileName(sFile)
Dim sFileRev
Dim iPos
getsBaseFileName = sFile
sFileRev = StrReverse(sFile)
'Get rid of the extension
iPos = Instr(1, sFileRev, ".",1)
If iPos < 1 Then
Exit Function
End If
sFileRev = Right(sFileRev, Len(sFileRev)-iPos)
'Get rid of trailing numbers
Do
If InStr(1, "1234567890", Left(sFileRev, 1), 1) Then
sFileRev = Right(sFileRev, Len(sFileRev)-1)
Else
Exit Do
End If
Loop While(Len(sFileRev) > 0)
getsBaseFileName = StrReverse(sFileRev)
End Function
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.
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