I'm trying to save and then load a multi-dimensional VBA array to/from disk. According to the MSDN website, the number of dimensions are saved as a descriptor in the file, but I can't figure out how to access/load them. The example below works, but only because I have hard coded the array dimensions. The commented out line works in a dynamic sense, but the array's dimensions are lost in the process.
Here's some sample code:
Sub WriteArray()
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim values() As Boolean
ReDim values(1 To 5, 1 To 10, 1 To 20)
Dim i As Integer 'Populate the simple array
For i = 1 To 20
values(1, 1, i) = True
Next
' Delete existing file (if any).
file_name = "array.to.file.vba.bin"
On Error Resume Next
Kill file_name
On Error GoTo 0
' Save the file.
fnum = FreeFile
Open file_name For Binary As #fnum
Put #fnum, 1, values
Close fnum
End Sub
Sub ReadArray()
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim newArray() As Boolean
file_name = "array.to.file.vba.bin" 'txtFile.Text"
fnum = FreeFile
file_length = FileLen(file_name)
'ReDim newArray(1 To file_length) 'This loads the data, but not with the right dimensions.
ReDim newArray(1 To 5, 1 To 10, 1 To 20) 'This works but with dimensions hard coded.
'How to re-dim here using the dimensions saved in the file?
Open file_name For Binary As #fnum
Get #fnum, 1, newArray
Close fnum
End Sub
I need to give credit to the VB Helper website because the example above is based on one they posted here.
To be honest I didn't know this VBA technique which allows to write array into text file. Or maybe I forgot it. :) Therefore I dived into it.
1st. Writing to the file.
I have some problems with Boolean type of your array. It's not working but it's working with Variant type. And I changed open mode from Binary to Random. Moreover, I used Len parameter for Open Statement with value according to this MSDN information.
This is the first sub improved:
Sub WriteArray()
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim values() As Variant
ReDim values(1 To 5, 1 To 10, 1 To 20)
Dim i As Integer 'Populate the simple array
For i = 1 To 20
values(1, 1, i) = True
Next
' Delete existing file (if any).
file_name = "array.to.file.vba.bin"
On Error Resume Next
Kill file_name
On Error GoTo 0
' Save the file.
fnum = FreeFile
'<<<<<<< this is new >>>>>>>
Dim arrLen As Long
arrLen = (2 + 3 * 8) + (5 * 10 * 20 * 3)
'<<<<<<< this is changed >>>>>>>
Open file_name For Random As #fnum Len = arrLen
Put #fnum, 1, values
Close fnum
End Sub
2nd. Reading from file
Our array will be Variant type dynamic. I changed file open type to Random from Binary and used Len parameter with the max possible value according to this MSDN information.
This is the second sub improved:
Sub ReadArray()
Dim file_name As String
Dim fnum As Integer
Dim newArray() As Variant
file_name = "array.to.file.vba.bin" 'txtFile.Text"
fnum = FreeFile
'<<<<<<< this is new >>>>>>>
Dim lenAAA
lenAAA = 32767 '>>> MAX possible value
'<<<<<<< this is changed >>>>>>>
Open file_name For Random As #fnum Len = lenAAA
Get #fnum, 1, newArray
Close fnum
End Sub
Screen shot of variables value.
Related
I am trying to assign an array to a range of values in an Excel sheet.
When I do though, even though using debug the array is not all zeros, it returns all zeros.
The weird thing is for the dat1 variable it does write to the cells correctly. Though that along with dat2 is an array of strings.
Thanks in advance.
Sub Comparor()
Dim dat1() As Variant
Dim dat2() As Variant
dat1() = Sheets("Data1").Range("E1:E10").Value2
dat2() = Sheets("Data2").Range("E1:E10").Value2
Dim iTemp As Integer
iTemp = CInt(UBound(dat1))
Dim NumMatches() As Integer
ReDim NumMatches(iTemp)
Dim iNum As Integer
Dim iCompareInner As Integer 'dat 2 cycler
Dim iCompareOuter As Integer 'dat 1 cycler
For iCompareOuter = 1 To UBound(dat1)
For iCompareInner = 1 To UBound(dat2)
If (dat1(iCompareOuter, 1) = dat2(iCompareInner, 1)) Then
NumMatches(iCompareOuter) = NumMatches(iCompareOuter) + 1
End If
Next iCompareInner
Next iCompareOuter
Dim test22(10, 1) As Integer
For iNum = 1 To UBound(NumMatches)
'Debug.Print NumMatches(iNum)
test22(iNum, 1) = NumMatches(iNum)
Debug.Print test22(iNum, 1)
Next iNum
Sheets("Info").Range("E1:E10").Value2 = dat1
Sheets("Info").Range("F1:F10").Value2 = test22
Sheets("Info").Range("G1:G10").Value2 = NumMatches
End Sub
Count Matches (Dictionary, CountIf, Array (Double-Loop))
All three solutions do the same thing.
Using them with some serious data, e.g. 1K uniques on 100K values (means e.g. 100M iterations in the array version) will reveal the efficiency of each code.
But this is more about 2D one-based (one-column) arrays commonly used with (one-column) ranges.
The code is basic i.e. no blanks or error values are expected and each range has at least 2 cells
(i.e. Data = rg.Value with one cell doesn't work).
Option Explicit
Sub ComparorDictionary()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Read values (duplicates)
Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
Dim vData() As Variant: vData = vws.Range("E1:E10").Value
Dim vrCount As Long: vrCount = UBound(vData, 1)
' Count matches using a dictionary.
Dim vDict As Object: Set vDict = CreateObject("Scripting.Dictionary")
vDict.CompareMode = vbTextCompare
Dim vr As Long
For vr = 1 To vrCount
vDict(vData(vr, 1)) = vDict(vData(vr, 1)) + 1
Next vr
Erase vData ' values data is counted in the dictionary
' Read uniques (no duplicates).
Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
Dim uData() As Variant: uData = uws.Range("E1:E10").Value
Dim urCount As Long: urCount = UBound(uData, 1)
' Write count.
Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
Dim ur As Long
For ur = 1 To urCount
If vDict.Exists(uData(ur, 1)) Then
uMatches(ur, 1) = vDict(uData(ur, 1))
End If
Next ur
Set vDict = Nothing ' data is in the unique arrays
' Write result.
Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
dws.Range("E1").Resize(urCount).Value = uData
dws.Range("F1").Resize(urCount).Value = uMatches
End Sub
Sub ComparorCountIf()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference values (duplicates). No array is needed.
Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
Dim vrg As Range: Set vrg = vws.Range("E1:E10")
' Read uniques (no duplicates).
Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
Dim uData() As Variant: uData = uws.Range("E1:E10").Value
Dim urCount As Long: urCount = UBound(uData, 1)
' Count matches and write the count.
Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
Dim ur As Long
For ur = 1 To urCount
uMatches(ur, 1) = Application.CountIf(vrg, uData(ur, 1))
Next ur
' Write result.
Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
dws.Range("E1").Resize(urCount).Value = uData
dws.Range("F1").Resize(urCount).Value = uMatches
End Sub
Sub ComparorArray()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Read values (duplicates).
Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
Dim vData() As Variant: vData = vws.Range("E1:E10").Value
Dim vrCount As Long: vrCount = UBound(vData, 1)
' Read uniques (no duplicates).
Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
Dim uData() As Variant: uData = uws.Range("E1:E10").Value
Dim urCount As Long: urCount = UBound(uData, 1)
' Count matches and write the count.
Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
Dim vr As Long
Dim ur As Long
For ur = 1 To urCount
For vr = 1 To vrCount
If uData(ur, 1) = vData(vr, 1) Then
uMatches(ur, 1) = uMatches(ur, 1) + 1
End If
Next vr
Next ur
Erase vData ' data is in the unique arrays
' Write result.
Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
dws.Range("E1").Resize(urCount).Value = uData
dws.Range("F1").Resize(urCount).Value = uMatches
End Sub
As I said in my comment, one of your declarations is wrong and because of that, the unexpected result. Please, try understanding the next (didactic) code, to clarify the issue:
Sub testArray1D2D()
Dim arr1D, arr2DStrange, arr2D, i As Long
arr1D = Split("a,b,c,d,e,f,g,h,i,j", ",")
ReDim arr2DStrange(10, 1): ReDim arr2D(1 To 10, 1 To 1)
For i = 0 To UBound(arr1D)
arr2DStrange(i, 1) = arr1D(i)
arr2D(i + 1, 1) = arr1D(i)
Next i
Range("A2").Resize(UBound(arr2DStrange), 1).value = arr2DStrange 'it returns nothing
Range("B2").Resize(UBound(arr2DStrange), 2).value = arr2DStrange 'it returns what you need in the second column (D:D)
Range("D2").Resize(UBound(arr2D), 1).value = arr2D 'it returns correctly (what you need)
Range("E2").Resize(UBound(arr1D) + 1, 1).value = Application.Transpose(arr1D) 'also correct (a 1D array does not have any column! and it must be transposed. Otherwise, it repeats its first element value)
End Sub
When use declaration Dim test22(10, 1) As Integer it creates a 2D array but it has two columns. It is the equivalent of Dim test22(0 to 10, 0 to 1) As Integer. When you fill only the second column (1) and try returning the first one (0), this column, is empty.
The correct declaration for obtaining a 2D array with 10 rows and 1 column should be Dim test22(1 to 10, 1 to 1) As Integer.
Then, iTemp = CInt(UBound(dat1)) declares a 1D array of 11 elements (from 0, inclusive, to 10). And you never loaded its first element, starting iteration with 1. That's why the line Sheets("Info").Range("G1:G10").Value2 = NumMatches returned the first empty element 10 times... If your code would fill correctly the first element and if it was a matching one, your code will return 10 rows of 1 value.
NumMatches(iCompareOuter) = NumMatches(iCompareOuter) + 1 is the equivalent of NumMatches(iCompareOuter) = 1. NumMatches(iCompareOuter) is always empty in that moment...
And it is good to cultivate the habit to avoid declarations As Integer in such a case. Working with Excel rows, the value of an Integer must be exceeded. Try using As Long. VBA is so designed to make the memory working in the same way, without any supplementary stress.
A more compact way to accomplish what you need will be the next approach:
Sub Comparor()
Dim dat1(), dat2(), NumMatches(), mtch, i As Long
dat1() = Sheets("Data1").Range("E1:E10").Value2
dat2() = Sheets("Data2").Range("E1:E10").Value2
ReDim NumMatches(1 To UBound(dat1), 1 To 1)
For i = 1 To UBound(dat1)
mtch = Application.match(dat1(i, 1), dat2, 0)
If IsNumeric(mtch) Then NumMatches(i, 1) = "OK"
Next i
Sheets("Info").Range("G1:G10").Value2 = NumMatches
End Sub
Not tested, but it should work. Except the case of a typo, when an error will be raised and sending some feedback I will rapidly correct...
This for example
Dim test22(10, 1) As Integer
in the absence of Option Base 1 is the same as
Dim test22(0 to 10, 0 to 1) As Integer
I'd use
Dim test22(1 to 10, 1 to 1) As Integer
if you want to match the arrays you read from the worksheet. Otherwise, dropping those arrays to a range only gives you the first "column" (which are all zeros since you never assigned anything there...)
I am trying to store a filename in a array but i am getting Type mismatch error. I have changed the data type but it didn't work. Kindly help.
The code block that is throwing error,
Sub Example2()
Dim objFile,objFile1,objFolder,objFolder1 As Object
Dim splitting, counter, filename, filename1, splitting1, counter1,As Variant
Dim myarray() As Variant
For Each objFile In objFolder.Files
splitting = Split(objFile.Name, "\", 9)
counter = UBound(splitting)
filename = splitting(counter)
For Each objFile1 In objFolder1.Files
splitting1 = Split(objFile1.Name, "\", 9)
counter1 = UBound(splitting1)
filename1 = splitting1(counter1)
If srch1 = srch2 Then
ReDim Preserve myarray(UBound(myarray) + 1)
myarray() = filename1
End If
Next
Next
Get File Paths (to Array) Function
Links
Objects
FileSystemObject Object
GetFolder Method
File Object
The Code
Option Explicit
Function getFilePaths(ByVal FolderPath As String, _
Optional ByVal FirstIndex As Long = 1) _
As Variant
Dim fso As Object
Dim fsoFldr As Object
Dim fsoFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFldr = fso.GetFolder(FolderPath)
Dim LastIndex As Long
LastIndex = FirstIndex - 1
Dim Data() As Variant
For Each fsoFile In fsoFldr.Files
LastIndex = LastIndex + 1
ReDim Preserve Data(FirstIndex To LastIndex)
Data(LastIndex) = fsoFile.Path ' or .Name, .ParentFolder ...
Next fsoFile
getFilePaths = Data
End Function
Sub TESTgetFilePath()
' Define Folder Path ('fPath').
Const fPath As String = "F:\Test\2020"
' Populate File Paths Array ('Data').
Dim Data As Variant
Data = getFilePaths(fPath)
' Validate File Paths Array.
If IsEmpty(Data) Then
MsgBox "No files found.", vbCritical, "Fail"
Exit Sub
End If
' Write title to the Immediate window (CTRL+G).
Debug.Print "The List"
' Write values from File Paths Array to a String ('Result').
Dim Result As String
Result = Join(Data, vbLf)
' Write file paths to the Immediate window (CTRL+G).
Debug.Print Result
End Sub
EDIT 1:
Sub Example2()
Const FolderPath As String = "C:\Test"
Dim fso As Object
Dim objFolder As Object
Dim objFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(FolderPath)
Dim LastIndex As Long
LastIndex = -1
Dim MyArray() As Variant
For Each objFile In objFolder.Files
LastIndex = LastIndex + 1
ReDim Preserve MyArray(LastIndex)
MyArray(LastIndex) = objFile.Name
Next objFile
Dim n As Long
For n = LBound(MyArray) To UBound(MyArray)
Debug.Print n, MyArray(n)
Next n
End Sub
EDIT 2:
Sub Example3()
' For a fileformat aaa-bbb-rev*.*, where 'rev' is to be tested if greater.
' Two hyphens only.
Const FolderPath As String = "F:\Test\2020\64568450"
Const fSep As String = "-"
Dim pSep As String
pSep = Application.PathSeparator
Dim fso As Object
Dim objFolder As Object
Dim objFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(FolderPath)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim FileParts As Variant ' An array containing the split file name.
Dim fName As String ' File part before the 2nd hyphen (minus) '-'
Dim fRevision As String ' File part after the 2nd hyphen (minus) '-'
Dim LastIndex As Long
LastIndex = -1
Dim MyArray() As Variant
' Write file paths to array.
For Each objFile In objFolder.Files
FileParts = Split(objFile.Name, fSep)
fName = FileParts(0) & fSep & FileParts(1)
fRevision = FileParts(2)
If Not dict.Exists(fName) Then
dict(fName) = fRevision
Else
LastIndex = LastIndex + 1
ReDim Preserve MyArray(LastIndex)
If dict(fName) < fRevision Then
MyArray(LastIndex) = FolderPath & pSep & fName _
& fSep & fRevision
dict(fName) = fRevision
Else
MyArray(LastIndex) = objFile.Path
End If
End If
Next objFile
' Now 'MyArray' contains the list of file paths of the files to be moved.
Dim n As Long
For n = LBound(MyArray) To UBound(MyArray)
Debug.Print n, MyArray(n)
Next n
End Sub
Arrays in VBA can be either static or dynamic.
A static array is declared with a fixed size:
Dim myStaticArr(10) As String
declares an array with a fixed number of members (usually 11 as the lower index starts at 0, but you can overwrite this).
If you want to be sure about the lower index, you can specify
Dim myStaticArr(1 to 10) As String
Now you have 10 elements (from 1 to 10).
Similar, a multidimensional array can be defined
Dim myStaticArr3D(1 to 10, 1 to 5, 1 to 8) As String
Now you have an array with 10 * 5 * 8 members.
All of these arrays have in common that you need to declare at compile time the size of the array. The VBA compiler will reserve the necessary amount of memory and you cannot resize it.
If you don't know at compile time how large your array will be, you can declare it as dynamic array (as you do)
Dim myDynamicArr() as String
This reserves no memory at all. Before you can write something into the array, you need to tell VBA how big the array will be. This is done using the Redim statement. Easiest form:
Redim myDynamicArr(1 to 10) as String
Usually, this is done after calculating the size needed, so you will usually find the Redim having a variable that was used to calculate the needed size:
Redim myDynamicArr(1 to sizeNeeded) as String
Now there are cases where you find at runtime that the needed size is too small. You can issue another Redim to increase the size - but as you want to keep the content of the array, you specify the option Preserve:
Redim Preserve myDynamicArr(1 to 2*sizeNeeded) as String
This will double the size and keep the content of the first members (omitting the Preserve option will double the size but the content of the existing members will get lost).
To get the current size of an array, you can use the functions LBound and UBound. This can be used on static and dynamic arrays:
Dim myStaticArr(5 to 99) As String
Debug.Print LBound(myStaticArr), UBound(myStaticArr)
>> 5 99
Dim myDynamicArr() As String
ReDim myDynamicArr(1 to 20)
Debug.Print LBound(myDynamicArr), UBound(myDynamicArr)
>> 1 20
However, if you have a dynamic array and you never assigned memory to it, the functions LBound and UBound will throw a runtime error 9 "Subscript out of range"
Now what you want to do is to increase the size of the array by 1 every time you find a new value. You achieve this with
ReDim Preserve myarray(UBound(myarray) + 1)
which will look to the current size of the array using the UBound-function and resize it by 1, preserving its contents. That's fine, except for the fact that the very first time this statement is hit, the size of the array is undefined.
The easiest way to handle this is to use a variable that keeps track of your array size:
Dim myArray() as String, myArraySize as Long
(...)
myArraySize = myArraySize + 1
ReDim Preserve myArray(1 to myArraySize)
myarray(myArraySize) = filename1
One remark: ReDim Preserve is a rather expensive command. If you are dealing with a few entries, this doesn't matter, but if you are dealing with 100s or 1000s of elements, you should consider to use a Collection.
You should index to the array to set the value after Redim:
ReDim Preserve myarray(UBound(myarray) + 1)
myarray(ubound(myarray)) = filename1
VBA arrays are so finicky and frustrating. I would add items to a string and after then split it to an array:
Dim strArray As String
strArray = ""
REM .....
strArray = strArray + filename1 + ","
REM .....
myarray = Split(strArray,",")
I have trouble finding examples for this specific question.
I'm automating a task in Excel and I need users to paste a list of id-numbers in an areabox. When they click ok, I need my macro to get this list in an array so I can loop trough these id's and work with them (I want to check the formats, then paste the correct once in a column in Excel)
I tried and added a RefEdit on a userform, (multiline true, scrollbars both)
I've added this to be launched when click ok:
Dim data As Variant
Dim elemnt As Variant
data = Split(Simcards.simcardsArea.Text, vbNewLine)
For Each element In data
MsgBox element
Next element
Is there a better tool for this usage? Or is this the way to go?
I need the user to be able to paste the list of id's from a copy of any program, Excel, notepad, e-mail,..
Thank you
Option Explicit
Sub TestMe()
Dim arrayRange As Range
Set arrayRange = Application.InputBox("Enter a range", "Range:", Type:=8)
Dim myArr As Variant
Dim size As Long: size = arrayRange.Rows.Count - 1
ReDim myArr(size)
Dim myCell As Range
Dim myRow As Long: myRow = 0
For myRow = 0 To size
myArr(myRow) = arrayRange.Cells(myRow + 1, 1)
Next
Dim myVal As Variant
For Each myVal In myArr
Debug.Print myVal
Next myVal
End Sub
The trick is to pay attention how the array is assigned. The idea is that the array should be as big as the size number of the rows in the selected area, hence:
Dim size As Long: size = arrayRange.Rows.Count - 1
ReDim myArr(size)
The -1 is needed, because the arrays start from 0, unless someone writes Option Base 1 on the top of our code and break anything we have hoped for.
As arrays start with a 0, it is good to loop this way:
For myRow = 0 To size
myArr(myRow) = arrayRange.Cells(myRow + 1, 1)
Next
I'm trying to display an average from a txt file that has both restaurant names and net worth in a list. I'm displaying it in a label. I'm still learning Visual Basic, so I'm not even sure if my code is just a bunch of garbage. Here's what I've got. Not only is it not displaying anything, but it also has an error
"Structure "Integer" cannot be indexed because it has no default
value"
for intNumber. Here's what I have:
Private Sub btnCompute_Click(sender As Object, e As EventArgs) Handles
btnCompute.Click
Dim objReader As IO.StreamReader
Dim strLocationAndNameOfFile As String = "I:\franchise.txt"
Dim IntTotal As Integer
Dim intNumber As Integer
Dim intElement As Integer
Dim intAverage As Integer
Dim intCount As Integer = 10
If IO.File.Exists(strLocationAndNameOfFile) Then
objReader = IO.File.OpenText(strLocationAndNameOfFile)
For Each intElement In intNumber(strLocationAndNameOfFile)
IntTotal += intElement
Next
intAverage = IntTotal / intCount
lblAverageCost.Text = intAverage.ToString("C")
End If
End Sub
Although you are opening the text file, you're not actually reading it. Also there are a few slightly different ways I'd do things - have a look at the code an comments.
Dim strLocationAndNameOfFile As String = "I:\franchise.txt"
Dim IntTotal As Integer
Dim intAverage As Integer
Dim intNumberCount As Integer
'Use a string array to store the file contents
'instead of using a separate intElements variable (which btw you defined as an individual
'integer instead of an array, just use the string array to store the text of the file
'without also having to use an integer array. In the loop below, each element of the string
'array is parsed into an integer as needed, so no need for an extra array
Dim fileLines() As String
If IO.File.Exists(strLocationAndNameOfFile) Then
'The using statement opens the file and the end using statement will close the file and
'dispose of the sr object. Its important to close a file when you're done using it
Using sr As New StreamReader(strLocationAndNameOfFile)
'This line does three things. .ReadToEnd reads all the lines in the file and then splits the
'lines into individual strings. I'm assuming that the lines end with a VbCrLf and not a VbCr
'Finally those individual lines are stored in the string array
fileLines = sr.ReadToEnd.Split(vbCrLf)
'file is closed here and the sr object is disposed
End Using
'Here the code loops through each element of fileLines and trys to parse them into an integer and
'assin the integer to intNumber. If successful, the number is added to the total and 1 is added to
'intNumberCount to keep track of the number of successfully parsed numbers
For Each line As String In fileLines
Dim intNumber As Integer
If Integer.TryParse(line, intNumber) Then
IntTotal += intNumber
intNumberCount += 1
End If
Next
'finally the average is calculated
intAverage = IntTotal / intNumberCount
lblAverageCost.Text = intAverage.ToString("C")
End If
I'm lost, I try to fill arrays and receive a type mismatch
I'm trying to fill 4 arrays from one file
There is 500 lines in the text document each holding 4 different types of data separated by ","
The .txt file format example --->
pear, apple, grape, orange
apple, pear, orange, grape
ect...
Here is my code:
Private Sub CmdRun_Click()
Dim ticketid(500) As Variant
Dim theatreid(500) As Variant
Dim ticketamount(500) As Variant
Dim paymethod(500) As Variant
Open "C:\Users\Dylaan\Desktop\School Solution\tickets.txt" For Input As #1
Do While Not EOF(1)
Input #1, ticketid(), theatreid(), ticketamount(), paymethod()
lstticketid.AddItem ticketid()
lsttheatreid.AddItem theatreid()
lstticketamount.AddItem ticketamount()
lstmethod.AddItem paymethod()
Exit Do
Loop
Close #1
End Sub
Why?
take a look on this:
Private Sub CmdRun_Click()
Dim ticketid(500) As Variant
Dim theatreid(500) As Variant
Dim ticketamount(500) As Variant
Dim paymethod(500) As Variant
dim ix as integer
Open "C:\Users\Dylaan\Desktop\School Solution\tickets.txt" For Input As #1
ix = 0
Do While Not EOF(1)
Input #1, ticketid(ix), theatreid(ix), ticketamount(ix), paymethod(ix)
lstticketid.AddItem ticketid(ix)
lsttheatreid.AddItem theatreid(ix)
lstticketamount.AddItem ticketamount(ix)
lstmethod.AddItem paymethod(ix)
ix = ix + 1
Loop
Close #1
End Sub
And of course you should consider to use
freefile (to get a filehandle)
and also the possibility that there are MORE records than expected ...
Set fso = CreateObject("Scripting.FileSystemObject")
Set srcfile = fso.GetFile("c:\myfile.txt")
If err.number = 0 then Set TS = srcFile.OpenAsTextStream(1, 0)
Src=ts.readall
Arr1=Split(Src, vbcrlf)
For Each thing in Arr1
Arr2=Split(thing, ",")
For Each thing2 in Arr2
msgbox thing2
Next
Next
This is vbscript but will work in VB6. We are using the split command.
Some comments on your code:
You don't need to declare those arrays as variants, you can declare them as arrays of strings.
As the file is just 500 lines you can read it in at once.
Your real problem is the input command: It can't read in arrays at once.
The same applies to the listbox: You can't add an array at once.
With all that applied have a look at the following test project:
'1 form with:
' 1 command button : name=Command1
' 4 listbox controls : name=List1 name=List2 name=List3 name=List4
Option Explicit
Private Sub Command1_Click()
Dim strData As String
strData = ReadFile("c:\temp\file.txt")
ShowData strData
End Sub
Private Sub Form_Resize()
Dim sngWidth As Single
Dim sngCmdHeight As Single
Dim sngLstWidth As Single, sngLstHeight As Single
sngWidth = ScaleWidth
sngCmdHeight = 315
sngLstHeight = ScaleHeight - sngCmdHeight
sngLstWidth = sngWidth / 4
List1.Move 0, 0, sngLstWidth, sngLstHeight
List2.Move sngLstWidth, 0, sngLstWidth, sngLstHeight
List3.Move 2 * sngLstWidth, 0, sngLstWidth, sngLstHeight
List4.Move 3 * sngLstWidth, 0, sngLstWidth, sngLstHeight
Command1.Move 0, sngLstHeight, sngWidth, sngCmdHeight
End Sub
Private Function ReadFile(strFile As String) As String
Dim intFile As Integer
Dim strData As String
intFile = FreeFile
Open strFile For Input As #intFile
strData = Input(LOF(intFile), #intFile)
Close #intFile
ReadFile = strData
End Function
Private Sub ShowData(strData As String)
Dim lngLine As Long
Dim strLine() As String
Dim strPart() As String
strLine = Split(strData, vbCrLf)
For lngLine = 0 To UBound(strLine)
strPart = Split(strLine(lngLine), ",")
If UBound(strPart) = 3 Then
List1.AddItem strPart(0)
List2.AddItem strPart(1)
List3.AddItem strPart(2)
List4.AddItem strPart(3)
Else
'not the correct number of items
End If
Next lngLine
End Sub
When you click on Command1 it will read in the textfile from c:\temp\file.txt
After that it will split the data to form an array of lines, loop over all lines, split each line into part, and show the parts in the listboxes, if there are exactly 4 parts on a line.