I want to load the ascii code of all letters and digits in first n bytes (100000 for example) of a binary file into an array. I wrote this code:
Option Explicit
Dim i, lCharCount, lFileByte, lFileArray(99999)
Dim oFSO, oStream, sInFileName
'Validate input command line
If WScript.Arguments.Count < 1 Then
MsgBox "No input file has been specified!", vbExclamation, "My Script"
WScript.Quit
End If
sInFileName = WScript.Arguments(0)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oStream = oFSO.OpenTextFile(sInFileName, 1)
Do While Not oStream.AtEndOfStream
lFileByte = Asc(oStream.Read(1))
If (lFileByte > 47 And lFileByte < 58) Or (lFileByte > 64 And lFileByte < 91) Or (lFileByte > 96 And lFileByte < 123) Then
lFileArray(lCharCount) = lFileByte
lCharCount = lCharCount + 1
If lCharCount = 100000 Then Exit Do
End If
Loop
oStream.Close: Set oStream = Nothing
But I need it to run faster. I'd rather not use ADODB but, I'm open to all suggestions if it can't be sped up using FSO. Any ideas?
Try something like this:
cnt = 100000
data = oFSO.OpenTextFile(sInFileName).Read(cnt)
ReDim lFileArray(Len(data)-1)
For i = 1 To Len(data)
lFileArray(i-1) = Asc(Mid(data, i, 1))
Next
Try calling ReadAll on your file instead char by char. This will read the entire file and return it as a string. Then use the same loop, but this time on the returned string, using string scan methods.
Related
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 have a folder full of .txt files that contain test data. I wrote a macro to sift through the .txt files to extract the information I want based on some search criteria and then write those search results into a binary file.
So now that I have a binary file that contains a reduced data set, I wrote another macro to search binary file for what I actually want.
For some reason, my macro is very slow to read in data from the binary file.
As a comparison, I wrote a macro that looked through all txt files for a specific search, wrote that into binary file, and then just read that back into Excel. That only took 60 seconds.
Here's a snippet. I'm wondering if the if-else statement to check if it matches my search criteria [LC(a) and EID(e)] is slowing things down or size of binary file (only 200 MB).
Type MyBinaryRecordInfo
MyBinaryRecordInfo1(1 To 12) As String ' variable length
End Type
i = 1
Open currentpath & "\" & bin_fname & ".DAT" For Binary As #f
' read records from the binary file
For a = 1 To totalLC
For e = 1 To totalElm
Do While Loc(f) < LOF(f)
Call ReadBinRecord(MyRecord, f, ElmType)
Sheets(ElmType).Select
If MyRecord.MyBinaryRecordInfo1(1) = LC(a) Then
If MyRecord.MyBinaryRecordInfo1(2) = EID(e) Then
For j = 1 To totalbinrec
With MyRecord
Cells(i + 3, j) = .MyBinaryRecordInfo1(j)
End With
Next j
i = i + 1
Exit Do
End If
End If
Loop
Next e
Next a
Close #f ' close the file
Sub ReadBinRecord(MyRecord As MyBinaryRecordInfo, f As Integer, ElmType As String)
' reads the next record from an open binary file
Dim intSize As Integer
For j = 1 To totalbinrec
With MyRecord
Get f, , intSize ' read the size of the ID field
.MyBinaryRecordInfo1(j) = String(intSize, " ") ' set the variable length
Get f, , .MyBinaryRecordInfo1(j) ' read the variable string field
End With
Next j
Possibly the slow part is writing out to Excel. In particular, you change the sheet every time you read the row
Assuming you know the number of rows in the binary file in advance, you can read into memory and then write out once at the end. The code would look something like the following:
Option Explicit
Type MyBinaryRecordInfo
MyBinaryRecordInfo1(1 To 12) As String ' variable length
End Type
Sub x()
num_rows = 5000
Open currentpath & "\" & bin_fname & ".DAT" For Binary As #f
Dim V(1 To totalElm) As Variant
Dim V2(1 To num_rows, 1 To 12) As Variant
For e = 1 To totalElm
V(e) = V2
Next e
' read records from the binary file
For a = 1 To totalLC
For e = 1 To totalElm
Do While Loc(f) < LOF(f)
Call ReadBinRecord(MyRecord, f, ElmType)
If MyRecord.MyBinaryRecordInfo1(1) = LC(a) Then
If MyRecord.MyBinaryRecordInfo1(2) = EID(e) Then
For j = 1 To totalbinrec
With MyRecord
V(e)(i, j) = .MyBinaryRecordInfo1(j)
End With
Next j
i = i + 1
Exit Do
End If
End If
Loop
Next e
Next a
Close #f ' close the file
' write out
For e = 1 To totalElm
Sheets(ElmType).Select
Cells(3, 1).Resize(num_rows, 12).Value = V(e)
Next e
End Sub
Sub ReadBinRecord(MyRecord As MyBinaryRecordInfo, f As Integer, ElmType As String)
' reads the next record from an open binary file
Dim intSize As Integer
For j = 1 To totalbinrec
With MyRecord
Get f, , intSize ' read the size of the ID field
.MyBinaryRecordInfo1(j) = String(intSize, " ") ' set the variable length
Get f, , .MyBinaryRecordInfo1(j) ' read the variable string field
End With
Next j
End Sub
If you don't know the number of rows then you just Redim Preserve the inner variants once every 500 rows or so.
As this writes everything out at the end, you might find it helpful to use Application.Statusbar = "my string" to write a progress message
I have a problem in that I need to read a specified quantity of characters from a text file, but the specified quantity varies so I cannot use a constant EG:
variable = WhateverIsSpecified
strText = objFile.Read (variable) ' 1 ~ n+1
objOutfile.write strText
NOT
strText = objFile.Read (n) ' n = any constant (interger)
When using the first way, the output is blank (no characters in the output file)
Thanks in advance
UPDATE
These are the main snippets in a bit longer code
Set file1 = fso.OpenTextFile(file)
Do Until file1.AtEndOfStream
line = file1.ReadLine
If (Instr(line,"/_N_") =1) then
line0 = replace(line, "/", "%")
filename = file1.Readline
filename = Left(filename, len(filename)-3) & "arc"
Set objOutFile = fso.CreateTextFile(destfolder & "\" & filename)
For i = 1 to 5
line = file1.Readline
next
nBytes = line 'this line contains the quantity needed to be read eg 1234
Do until Instr(line,"\") > 0
line = file1.ReadLine
Loop
StrData = ObjFile.Read (nBytes)
objOutFile.Write StrData
objOutFile.close
End if
Loop
WScript.quit
My own stupid error,
StrData = ObjFile.Read (nBytes)
should be
StrData = file1.Read (nBytes)
I know how to do it in VB.Net but not an idea in vb6.
What I what to achieve is to avoid reading the whole file.
Is that possible?
You could open the file using Random access. Work your way backward a byte at a time, counting the number of carriage return line feed character pairs. Store each line in an array, or something similar, and when you've read your 400 lines, stop.
Cometbill has a good answer.
To open file for Random access:
Open filename For Random Access Read As #filenumber Len = reclength
To get the length of the file in Bytes:
FileLen(ByVal PathName As String) As Long
To read from Random access file:
Get [#]filenumber,<[recnumber]>,<varname>
IMPORTANT: the <varname> from the Get function must be a fixed length string Dim varname as String * 1, otherwise it will error out with Bad record length (Error 59) if the variable is declared as a variable length string like this Dim varname as String
EDIT:
Just wanted to point out that in Dim varname as String * 1 you are defining a fixed length string and the length is 1. This is if you wish to use the read-1-byte-backwards approach. If your file has fixed length records, there is no need to go 1 byte at a time, you can read a record at a time (don't forget to add 2 bytes for carriage return and new line feed). In the latter case, you would define Dim varname as String * X where X is the record length + 2. Then a simple loop going backwards 400 times or untill reaching the beginning of the file.
The following is my take on this. This is more efficient than the previous two answers if you have a very large file, since we don't have to store the entire file in memory.
Option Explicit
Private Sub Command_Click()
Dim asLines() As String
asLines() = LoadLastLinesInFile("C:\Program Files (x86)\VMware\VMware Workstation\open_source_licenses.txt", 400)
End Sub
Private Function LoadLastLinesInFile(ByRef the_sFileName As String, ByVal the_nLineCount As Long) As String()
Dim nFileNo As Integer
Dim asLines() As String
Dim asLinesCopy() As String
Dim bBufferWrapped As Boolean
Dim nLineNo As Long
Dim nLastLineNo As Long
Dim nNewLineNo As Long
Dim nErrNumber As Long
Dim sErrSource As String
Dim sErrDescription As String
On Error GoTo ErrorHandler
nFileNo = FreeFile
Open the_sFileName For Input As #nFileNo
On Error GoTo ErrorHandler_FileOpened
' Size our buffer to the number of specified lines.
ReDim asLines(0 To the_nLineCount - 1)
nLineNo = 0
' Read all lines until the end of the file.
Do Until EOF(nFileNo)
Line Input #nFileNo, asLines(nLineNo)
nLineNo = nLineNo + 1
' Check to see whether we have got to the end of the string array.
If nLineNo = the_nLineCount Then
' In which case, flag that we did so, and wrap back to the beginning.
bBufferWrapped = True
nLineNo = 0
End If
Loop
Close nFileNo
On Error GoTo ErrorHandler
' Were there more lines than we had array space?
If bBufferWrapped Then
' Create a new string array, and copy the bottom section of the previous array into it, followed
' by the top of the previous array.
ReDim asLinesCopy(0 To the_nLineCount - 1)
nLastLineNo = nLineNo
nNewLineNo = 0
For nLineNo = nLastLineNo + 1 To the_nLineCount - 1
asLinesCopy(nNewLineNo) = asLines(nLineNo)
nNewLineNo = nNewLineNo + 1
Next nLineNo
For nLineNo = 0 To nLastLineNo
asLinesCopy(nNewLineNo) = asLines(nLineNo)
nNewLineNo = nNewLineNo + 1
Next nLineNo
' Return the new array.
LoadLastLinesInFile = asLinesCopy()
Else
' Simply resize down the array, and return it.
ReDim Preserve asLines(0 To nLineNo)
LoadLastLinesInFile = asLines()
End If
Exit Function
ErrorHandler_FileOpened:
' If an error occurred whilst reading the file, we must ensure that the file is closed
' before reraising the error. We have to backup and restore the error object.
nErrNumber = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
Close #nFileNo
Err.Raise nErrNumber, sErrSource, sErrDescription
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
So I have a number of text files that I'm trying to read with Visual Basic. They all have the same formatting:
[number of items in the file]
item 1
item 2
item 3
...etc.
What I'm trying to do is declare an array of the size of the integer in the first line, and then read each line into corresponding parts of the array (so item 1 would be array[0], item 2 would be array[1], etc. However, I'm not sure where to start on this. Any help would be appreciated.
Pretty basic stuff (no pun intended):
Dim F As Integer
Dim Count As Integer
Dim Items() As String
Dim I As Integer
F = FreeFile(0)
Open "data.txt" For Input As #F
Input #F, Count
ReDim Items(Count - 1)
For I = 0 To Count - 1
Line Input #F, Items(I)
Next
Close #F
try this for VB6
Dim file_id As Integer
Dim strline as string
Dim array_item() as string
'Open file
file_id = FreeFile
Open "C:\list.txt" For Input AS #file_id
Dim irow As Integer
irow = 0
'Loop through the file
Do Until EOF(file_id)
'read a line from a file
Line Input #file_id, strline
'Resize the array according to the line read from file
Redim Preserve array_item(irow)
'put the line into the array
array_item(irow) = strline
'move to the next row
irow = irow + 1
Loop
Close #file_id
The VB function you're looking for is "split":
http://www.vb-helper.com/howto_csv_to_array.html
Try this:
Dim FullText As String, l() As String
'''Open file for reading using Scripting Runtime. But you can use your methods
Dim FSO As Object, TS As Object
Set FSO = createbject("Scripting.FileSystemObject")
Set TS = createbject("Scripting.TextStream")
Set TS = FSO.OpenTextFile(FilePath)
TS.ReadLine 'Skip your first line. It isn't needed now.
'''Reading the contents to FullText and splitting to the array.
FullText = TS.ReadAll
l = Split(FullText, vbNewLine) '''the main trick
Splitting automatically resizes l() and stores all data.
Now the l() array has everything you want.