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.
Related
Excel VBA beginner coming back for more. I am creating a macro that does the following two things:
1) Searches through multiple worksheets in a single workbook for a specific piece of data (a name), variable A below
2) If that name appears, to copy a specific range of cells from the worksheet (variable X below) to the master file (variable B below)
Sub Pull_X_Click()
Dim A As Variant 'defines name
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination for data pulled from report
Dim ws As Worksheet
Dim rng As Range
A = Workbooks("B.xlsm").Worksheets("Summary").Range("A1").Value
Set B = Workbooks("B.xlsm")
Set X = Workbooks.Open("X.xlsm")
Set Destination = Workbooks("B").Worksheets("Input").Range("B2:S2")
'check if name is entered properly
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
Worksheets("Reference").Activate
Exit Sub
End If
X.Activate
For Each ws In X.Worksheets
Set rng = ws.Range("A" & ws.Rows.Count).End(xlUp)
If InStr(1, rng, A) = 0 Then
Else
X.ActiveSheet.Range("$A$2:$DQ$11").AutoFilter Field:=1, Criteria1:=A
Range("A7:CD7").Select
Selection.Copy
Destination.Activate
Destination.PasteSpecial
End If
Next ws
Application.ScreenUpdating = False
End Sub
UPDATE: I managed to resolve the previous compile error, and it seems that the code (should?) work. However, it gets to this step:
X.Activate
...and then nothing happens. There's no run-time errors or anything, but it doesn't seem to be searching through the file (variable X) or pulling any of the data based on the presence of variable A. Any thoughts?
What I would've done is loop through the rows and evaluate the column in which the necessary data appears and then avoiding copy/paste just make the target range equal to the source range:
Sub SearchNCopy()
Dim A As String 'The String you are searching for
Dim b As String ' the string where you shall be searching
Dim wbs, wbt As Workbook ' Declare your workbooks
Dim wss As Worksheet
Dim i, lrow As Integer
Set wbt = Workbooks("B.xlsm") 'Set your workbooks
Set wbs = Workbooks.Open("X.xlsm")
A = wbt.Worksheets("Summary").Range("A1").Value
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
Worksheets("Reference").Activate
Exit Sub
End If
For Each wss In wbs.Worksheets 'Loop through sheets
lrow = wss.Cells(wss.Rows.Count, "A").End(xlUp).Row 'Find last used row in each sheet - MAKE SURE YOUR SHEETS DONT HAVE BLANKS BETWEEN ENTIRES
For i = 1 To lrow Step 1 'Loop through the rows
b = wss.Range("A" & i).Value 'Assign the value to the variable from column a of the row
If Not InStr(1, b, A) = 0 Then 'Evaluate the value in the column a and if it contains the input string, do the following
wbt.Worksheets("Input").Range("B2:CC2") = wss.Range("A" & i & ":CD" & i) 'copies the range from one worksheet to another avoiding copy/paste (much faster)
End If
Next i
Next wss
End Sub
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)
Ok so I've searched and searched and can't quite find what I'm looking for.
I have a workbook and what I'm basically trying to do is take the entries from certain ranges (Sheet1 - E4:E12, E14:E20, I4:I7, I9:I12, I14:I17, & I19:I21) and put them in a separate list on Sheet2. I then want the new list on Sheet2 to be sorted by how many times an entry appeared on Sheet1 as well as display the amount.
example http://demonik.doomdns.com/images/excel.png
Obviously as can be seen by the ranges I listed above, this sample is much smaller lol, was just having trouble trying to figure out how to describe everything and figured an image would help.
Basically I am trying to use VBA (the update would be initialized by hitting a button) to copy data from Sheet1 and put all the ranges into one list in Sheet2 that is sorted by how many times it appeared on Sheet1, and then alphabetically.
If a better discription is needed just comment and let me know, I've always been horrible at trying to describe stuff like this lol.
Thanks in advance!
Another detail: I cant have it search for specific things as the data in the ranges on Sheet1 may change. Everything must be dynamic.
I started out with this data
and used the following code to read it into an array, sort the array, and count the duplicate values, then output the result to sheet2
Sub Example()
Dim vCell As Range
Dim vRng() As Variant
Dim i As Integer
ReDim vRng(0 To 0) As Variant
Sheets("Sheet2").Cells.Delete
Sheets("Sheet1").Select
For Each vCell In ActiveSheet.UsedRange
If vCell.Value <> "" Then
ReDim Preserve vRng(0 To i) As Variant
vRng(i) = vCell.Value
i = i + 1
End If
Next
vRng = CountDuplicates(vRng)
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(UBound(vRng), UBound(vRng, 2))) = vRng
Rows(1).Insert
Range("A1:B1") = Array("Entry", "Times Entered")
ActiveSheet.UsedRange.Sort Range("B1"), xlDescending
End Sub
Function CountDuplicates(List() As Variant) As Variant()
Dim CurVal As String
Dim NxtVal As String
Dim DupCnt As Integer
Dim Result() As Variant
Dim i As Integer
Dim x As Integer
ReDim Result(1 To 2, 0 To 0) As Variant
List = SortAZ(List)
For i = 0 To UBound(List)
CurVal = List(i)
If i = UBound(List) Then
NxtVal = ""
Else
NxtVal = List(i + 1)
End If
If CurVal = NxtVal Then
DupCnt = DupCnt + 1
Else
DupCnt = DupCnt + 1
ReDim Preserve Result(1 To 2, 0 To x) As Variant
Result(1, x) = CurVal
Result(2, x) = DupCnt
x = x + 1
DupCnt = 0
End If
Next
Result = WorksheetFunction.Transpose(Result)
CountDuplicates = Result
End Function
Function SortAZ(MyArray() As Variant) As Variant()
Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim x As Integer
Dim Temp As String
First = LBound(MyArray)
Last = UBound(MyArray)
For i = First To Last - 1
For x = i + 1 To Last
If MyArray(i) > MyArray(x) Then
Temp = MyArray(x)
MyArray(x) = MyArray(i)
MyArray(i) = Temp
End If
Next
Next
SortAZ = MyArray
End Function
End Result:
Here is a possible solution that I have started for you. What you are asking to be done gets rather complicated. Here is what I have so far:
Option Explicit
Sub test()
Dim items() As String
Dim itemCount() As String
Dim currCell As Range
Dim currString As String
Dim inArr As Boolean
Dim arrLength As Integer
Dim iterator As Integer
Dim x As Integer
Dim fullRange As Range
Set fullRange = Range("E1:E15")
iterator = 0
For Each cell In fullRange 'cycle through the range that has the values
inArr = False
For Each currString In items 'cycle through all values in array, if
'values is found in array, then inArr is set to true
If currCell.Value = currString Then 'if the value in the cell we
'are currently checking is in the array, then set inArr to true
inArr = True
End If
Next
If inArr = False Then 'if we did not find the value in the array
arrLength = arrLength + 1
ReDim Preserve items(arrLength) 'resize the array to fit the new values
items(iterator) = currCell.Value 'add the value to the array
iterator = iterator + 1
End If
Next
'This where it gets tricky. Now that you have all unique values in the array,
'you will need to count how many times each value is in the range.
'You can either make another array to hold those values or you can
'put those counts on the sheet somewhere to store them and access them later.
'This is tough stuff! It is not easy what you need to be done.
For x = 1 To UBound(items)
Next
End Sub
All that this does so far is get unique values into the array so that you can count how many times each one is in the range.
I wrote a simple program to write and read data from text file using FileSystemObject, but it doesn't work and gives me a runtime error:
Input Past End of File.
Kindly let me know the mistake I made here.
'Here is the Program -
Dim Fso 'Reference obect to File system
Dim TxtObj 'Reference to Text stream object
Dim Txt 'Reference to Text stream object to open file
Dim i 'To Read Text in file
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Txtobj = Fso.CreateTextFile("C:\Users\ACER\Desktop\Project Folder\NewText_3.txt")
Txtobj.Write("Hello")
Txtobj.Close
Set Txt = Fso.OpenTextFile("C:\Users\ACER\Desktop\Project Folder\NewText_3.txt",1)
Do while Txt.AtEndOfStream<>1
i = Txt.Read(1)
Loop
Msgbox i
Txt.close
Option Explicit ' safety belt
Const FSpec = "14481096.txt" ' dry the file name
Dim Fso 'Reference object to File system
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim TxtObj 'Reference to Text stream object (used for rwrite and read)
Set Txtobj = Fso.CreateTextFile(FSpec)
Txtobj.WriteLine "Hello"
Txtobj.Close
Dim Letter 'To Read Text in file (each letter)
Set Txtobj = Fso.OpenTextFile(FSpec) ' ForReading is the default, no need for magic number 1)
Do Until Txtobj.AtEndOfStream ' never compare boolean values against boolean literals
' or - worse - values of other types you *hope* VBScript
' will convert correctly
Letter = Txtobj.Read(1) ' letter
WScript.Echo "got", Letter
Loop
Txtobj.Close
output:
cscript 14481096.vbs
got H
got e
got l
got l
got o
got <-- aka cr
got <-- aka lf (in case you are wondering)
Extra hint:
>> WScript.Echo CInt(True), CInt(False)
>>
-1 0
>>
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