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.
Related
Assigning word document lines of text to an array to then print into an excel column. I want to print each item in array to it's own cell.
Currently, all the items are storying correctly into the array, but it's only printing the first item over and over Action
Code:
Option Explicit
Sub ParaCopy()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application")
Set wDoc = wApp.Documents.Open("J:\Data Dictionary.docx", ReadOnly:=True)
Dim wPara As Word.Paragraph
Dim arr() As Variant
Dim i As Long
i = 0
For Each wPara In wDoc.Paragraphs
If wPara.Range.Words.Count > 1 Then
ReDim Preserve arr(i)
arr(i) = wPara.Range
End If
i = i + 1
Next wPara
For i = LBound(arr) To UBound(arr)
[a1].Resize(UBound(arr) + 1) = arr
Next i
End Sub
EDIT: Need to separate each block of text separated by a space (outlined in blue) to this
Create a 2D array with one column and load that:
Option Explicit
Sub ParaCopy()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application")
Set wDoc = wApp.Documents.Open("J:\Data Dictionary.docx", ReadOnly:=True)
Dim wPara As Word.Paragraph
Dim arr() As Variant
ReDim arr(1 To wDoc.Paragraphs.Count, 1 To 1)
Dim i As Long
i = 1
For Each wPara In wDoc.Paragraphs
If wPara.Range.Words.Count > 1 Then
arr(i, 1) = wPara.Range
i = i + 1
End If
Next wPara
[a1].Resize(UBound(arr) + 1) = arr
End Sub
Copy Word Paragraphs to Excel Cells Using an Array
The number of rows of the array is wDoc.Paragraphs.Count which may differ from r (the 'actual count') hence you have to use r with Resize, and not wDoc.Paragraphs.Count or UBound(Data, 1).
Don't forget to Close the Document and Quit the App.
The first solution is early-bound and needs the library reference. When using it, just use
Set wApp = New Word.Application.
The second solution is late-bound and doesn't need the library reference. Also, it has been 'stripped off' the document and application variables (not necessary, you can declare them As Object).
Option Explicit
' e.g. Tools>References>Microsoft Word 16.0 Object Library
Sub ParaCopy()
Const FilePath As String = "J:\Data Dictionary.docx"
Dim wApp As Word.Application: Set wApp = Set wApp = New Word.Application
Dim wDoc As Word.Document: Set wDoc = wApp.Documents.Open(FilePath, , True)
Dim Data As Variant: ReDim Data(1 To wDoc.Paragraphs.Count, 1 To 1)
Dim wPara As Word.Paragraph
Dim r As Long
For Each wPara In wDoc.Paragraphs
If wPara.Range.Words.Count > 1 Then
r = r + 1
Data(r, 1) = wPara.Range
End If
Next wPara
wDoc.Close False
wApp.Quit
[a1].Resize(r) = Data
End Sub
Sub ParaCopyNoReference()
Const FilePath As String = "J:\Data Dictionary.docx"
With CreateObject("Word.Application")
With .Documents.Open(FilePath, , True)
Dim Data As Variant: ReDim Data(1 To .Paragraphs.Count, 1 To 1)
Dim wPara As Object
Dim r As Long
For Each wPara In .Paragraphs
If wPara.Range.Words.Count > 1 Then
r = r + 1
Data(r, 1) = wPara.Range
End If
Next wPara
.Close False
End With
.Quit
End With
[a1].Resize(r) = Data
End Sub
I'm importing a table from a Tab-separated text file. I'm only interested in certain columns, so this is what I'm trying to do:
No problem: Read entire file into one long string
No problem: Split long string into rows, along vbCrlf
No problem: split each row into cells, along vbTab. Put those values into a 2d array
Problem: Sheets("Sheet2").Range("A:A") = Matrix (only a selected column)
I need help to find the syntax how to address e.g. the 5th column of the matrix, all rows.
Did I make myself clear?
Open Filename For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
Debug.Print strData(1)
Dim Matrix() As String
Dim Fields() As String
Fields = Split(strData(0), vbTab)
Dim Rader As Long
Dim Kolumner As Long
ReDim Matrix(UBound(strData), UBound(Fields))
For Rader = 0 To UBound(strData)
Fields() = Split(strData(Rader), vbTab)
For Kolumner = 0 To UBound(Fields)
Matrix(Rader, Kolumner) = Fields(Kolumner)
Next Kolumner
Next Rader
Sheets("Sheet2").Range("A:A") = Matrix 'that gets me the first column. How to pick another matrix column?
Write Only Specified Columns From Array to Worksheet
Adjust the constants including the workbook and DataColumns.
The first Sub writes the columns specified in DataColumns to a worksheet.
The second Sub writes all columns to the worksheet.
The rest is being called.
ByRef (not necessary) is used to point out that values
are being modified in the referred variable.
The Code
Option Explicit
Sub writeColumns()
' Text
Const FilePath As String = "G:\Data\Baby Names\yob2018.txt"
Const LineDelimiter As String = vbCrLf
Const FieldDelimiter As String = ","
' Worksheet
Const wsId As Variant = "Sheet1"
Const FirstCell As String = "A1"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim DataColumns() As Variant: DataColumns = Array(3, 1)
' Write from Text File to Data Array.
Dim Data() As String
getTextToArray Data, FilePath, LineDelimiter, FieldDelimiter
' Write from Data Array to Columns Array.
Dim Cols() As Variant: Cols = getColumns(Data, DataColumns)
' Write from Columns Array to Columns Range.
writeWorksheet Cols, wb, wsId, FirstCell
End Sub
Sub writeAll()
' Text
Const FilePath As String = "G:\Data\Baby Names\yob2018.txt"
Const LineDelimiter As String = vbCrLf
Const FieldDelimiter As String = ","
' Worksheet
Const wsId As Variant = "Sheet1"
Const FirstCell As String = "A1"
Dim wb As Workbook: Set wb = ThisWorkbook
' Write from Text File to Data Array.
Dim Data() As String
getTextToArray Data, FilePath, LineDelimiter, FieldDelimiter
' Write from Data Array to Data Range.
writeWorksheet Data, wb, wsId, FirstCell
End Sub
Sub getTextToArray(ByRef Data() As String, _
ByVal FilePath As String, _
Optional ByVal LineDelimiter As String = vbCrLf, _
Optional ByVal FieldDelimiter As String = " ")
' Write from Text File to Text Variable.
Dim Text As String: getText Text, FilePath
' Write from Text Variable to Lines Array.
Dim Lines() As String: getLines Lines, Text, LineDelimiter
' Split Lines Array to Data Array.
getFields Data, Lines, FieldDelimiter
End Sub
Sub getText(ByRef Text As String, _
ByVal TextFilePath As String)
Open TextFilePath For Binary As #1
Text = Space$(LOF(1)): Get #1, , Text
Close #1
End Sub
Sub getLines(ByRef Lines() As String, _
ByVal Text As String, _
Optional ByVal LineDelimiter As String = vbCrLf)
Lines = Split(Text, LineDelimiter)
removeLastEmptyLines Lines
End Sub
Sub removeLastEmptyLines(ByRef Lines() As String)
If UBound(Lines) = -1 Then Exit Sub
Dim c As Long, ub As Long: ub = UBound(Lines)
For c = ub To LBound(Lines) Step -1
If Lines(c) = Empty Then
ub = ub - 1: ReDim Preserve Lines(ub)
Else
Exit For
End If
Next c
End Sub
Sub getFields(ByRef Data() As String, _
Lines() As String, _
Optional ByVal FieldDelimiter As String = " ")
Dim Fields() As String: Fields = Split(Lines(0), FieldDelimiter)
Dim ubL As Long: ubL = UBound(Lines) + 1
Dim ubF As Long: ubF = UBound(Fields) + 1
ReDim Data(1 To ubL, 1 To ubF)
Dim r As Long, c As Long
For r = 1 To ubL
Fields = Split(Lines(r - 1), FieldDelimiter)
For c = 1 To ubF
Data(r, c) = Fields(c - 1)
Next c
Next r
End Sub
Function getColumns(Data() As String, _
DataColumns() As Variant) _
As Variant
Dim ubD As Long: ubD = UBound(Data)
Dim ubC As Long: ubC = UBound(DataColumns)
Dim Result As Variant: ReDim Result(1 To UBound(Data), 1 To ubC + 1)
Dim r As Long, c As Long
For r = 1 To ubD
For c = 0 To ubC
Result(r, c + 1) = Data(r, DataColumns(c))
Next c
Next r
getColumns = Result
End Function
Sub writeWorksheet(Data As Variant, WorkbookObject As Workbook, _
Optional ByVal WorksheetNameOrIndex As Variant = "Sheet1", _
Optional ByVal FirstCellAddress As String = "A1")
With WorkbookObject.Worksheets(WorksheetNameOrIndex).Range(FirstCellAddress)
.Resize(UBound(Data), UBound(Data, 2)).Value = Data
End With
End Sub
I want to open a txt-File, read the textlines into arrays, delete specific arrays and write all those textlines into another textfile.
It might be easier to understand if you read the code:
Sub:
Open "G:\Arbeit\gen molding\Molding.spf" For Input As #1 'code from textfile below
Dim i As Integer
Dim tlmold() As String
Do Until EOF(1) 'read into array
ReDim Preserve tlmold(i)
Line Input #1, tlmold(i)
i = i + 1
Loop
Close #1
DeleteFromArray tlmold, "M17" 'function code below
DeleteFromArray tlmold, "I_R828"
*DeleteFromArray tlmold, "I_R872"*
Dim tllength As Integer
tllength = UBound(tlmold)
For i = tllength To 0 Step -1 'newtext is the text for the new txt-file
newtext = newtext & tlmold(i) & vbCrLf
Next i
newtext = Replace(newtext, "ÿþ", "") 'remove BOM
Set Fileout = fso.CreateTextFile("G:\Arbeit\gen molding\Molding2.spf", True, True) 'create new textfile
Fileout.Write newtext
Fileout.Close
Function:
Function DeleteFromArray(ByRef Arr As Variant, StringToBeDeleted As String)
Dim arrlength As Integer
Dim strtest As String
arrlength = UBound(Arr)
strtest = StringToBeDeleted
For i = 0 To arrlength
strtest = Arr(i)
If InStr(strtest, StringToBeDeleted) <> 0 Then
Arr(i) = ""
ReDim Preserve Arr(arrlength - 1)
Exit Function
End If
Next i
End Function
Textfile "MOLDING.SPF":
G01 Z=0.1
G01 X=24.371 Z=-0.886
G03 X=24.370 Z=-1.040 CR=15.075
G01 X=24.126 Z=-12.934
G02 X=24.121 Z=-13.232 CR=50.500
G01 X=I_R830 *Z=-I_R872* ;MOLDING END PT
G01 *Z=-I_R872*-1.200
G01 X=I_R828
M17
The problem is while deleting I_R872 from the textfile, my function does notReDim the array a second time.
Because I_R872 is two times in the textfile.
So the array tlmold(5), which shouldn't exist, is just empty.
I hope you understand my "code" and can help me with my problem.
Thanks in Advance
The easiest way to accomplish what you are trying to do is simply not to place the unwanted text into the array in the first place:
Open "G:\Arbeit\gen molding\Molding.spf" For Input As #1 'code from textfile below
Dim i As Long
Dim j As Long
Dim tlmold() As String
Dim lineIn as String
Dim wanted As Boolean
Dim unwantedText
unwantedText = Array("M17","I_R828","I_R872")
Do Until EOF(1) 'read into array
'Read an input line
Line Input #1, lineIn
'Now decide whether we want that record
wanted = True
For j = LBound(unwantedText) To UBound(unwantedText)
If InStr(lineIn, unwantedText(j)) > 0 Then
wanted = False
Exit For
End If
Next
'If we want this record, re-dimension the array and store the value
If wanted Then
ReDim Preserve tlmold(i)
tlmold(i) = lineIn
i = i + 1
End If
Loop
Close #1
Dim tllength As Integer
'...
An alternative way to bypass arrays and loops is to work with the entire text of the file
Option Explicit
Public Sub UpdateFile()
Const FPATH = "G:\Arbeit\gen molding\"
Const SRC_FILE = FPATH & "Molding.spf"
Const DST_FILE = FPATH & "Molding2.spf"
Dim fullFile As String
Open SRC_FILE For Binary As #1
fullFile = Space$(LOF(1)) 'Read entire file into variable fullFile
Get #1, , fullFile
Close #1
fullFile = Replace(fullFile, "M17", vbNullString)
fullFile = Replace(fullFile, "I_R828", vbNullString)
fullFile = Replace(fullFile, "ÿþ", vbNullString)
Open DST_FILE For Output As #1
Print #1, fullFile 'Write contents back to the new file
Close #1
End Sub
Using newtext = Join(tlmold,vbCrLf) is much faster than the loop below:
For i = tllength To 0 Step -1 'newtext is the text for the new txt-file
newtext = newtext & tlmold(i) & vbCrLf
Next i
You could also use the Scripting.FileSystemObject to read the file. I refactored your code using a StringBuilder instead of an array. StringBuilders are optimized for concatenating strings.
Sub CreateNewSPF()
Const SPF_FILENAME1 = "G:\Arbeit\gen molding\Molding.spf"
Const SPF_FILENAME2 = "G:\Arbeit\gen molding\Molding2.spf"
Const ForReading = 1
Const ForWriting = 2
Dim lineIn As String
Dim fso As Object, StringBuilder As Object, TextStream1 As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set StringBuilder = CreateObject("System.Text.StringBuilder")
Set TextStream1 = fso.OpenTextFile(SPF_FILENAME1, ForReading)
Do Until TextStream1.AtEndOfStream
lineIn = TextStream1.ReadLine
If isValidSPF(lineIn) Then StringBuilder.Append_3 lineIn & vbCrLf
Loop
TextStream1.Close
StringBuilder.Replace "ÿþ", ""
Set Fileout = fso.CreateTextFile(SPF_FILENAME2, True, True) 'create new textfile
Fileout.Write StringBuilder.ToString
Fileout.Close
End Sub
Function isValidSPF(lineIn As String) As Boolean
Dim v As Variant
For Each v In Array("M17", "I_R828", "I_R872")
If InStr(1, lineIn, v, vbTextCompare) > 0 Then Exit Function
Next
isValidSPF = True
End Function
I want to make a VB6 executable that can handle a text file (or more) that have the following format.
X1 field | Y1 field | Z1 field \n
X2 field | Y2 field | Z2 field \n
....\n
....\n
Xn field | Yn field | Zn field.
It look's like a table from db or csv file and I would like to make a VB6 program that can search, edit and add all these fields. Is there any library or framework in VB6 to help me?
A disconnected database.
Sub Randomise
Randomize
Set rs = CreateObject("ADODB.Recordset")
With rs
.Fields.Append "RandomNumber", 4
.Fields.Append "Txt", 201, 5000
.Open
Do Until Inp.AtEndOfStream
.AddNew
.Fields("RandomNumber").value = Rnd() * 10000
.Fields("Txt").value = Inp.readline
.UpDate
Loop
.Sort = "RandomNumber"
Do While not .EOF
Outp.writeline .Fields("Txt").Value
.MoveNext
Loop
End With
End Sub
It all depends on what you want to do with the data but you can use the following steps:
Read in the file, either per line or the complete file at once
Substract the data in the correct format
write the data to your favorite database/control
For example, to read in the whole file at once, and show its fields into a MSFlexGrid you can do the following:
'1 form with:
' 1 MSFlexFrid control: name=MSFlexGrid1
' 1 Command button: name=Command1
Option Explicit
Private Sub Command1_Click()
Dim lngLine As Long, lngField As Long
Dim intFile As Integer
Dim strFile As String
Dim strData As String
Dim strLine() As String, strField() As String
'read the file
strFile = "c:\temp\file.txt"
intFile = FreeFile
Open strFile For Input As #intFile
strData = Input(LOF(intFile), #intFile)
Close #intFile
'split the file in separate lines
strLine = Split(strData, "\n")
'fill the grid with the data
With MSFlexGrid1
.Rows = UBound(strLine) + 1
For lngLine = 0 To UBound(strLine)
'put all fields from 1 line on 1 row in the grid
strField = Split(strLine(lngLine), "|")
If UBound(strField) > .Cols - 1 Then
.Cols = UBound(strField) + 1
End If
For lngField = 0 To UBound(strField)
.TextMatrix(lngLine, lngField) = strField(lngField)
Next lngField
Next lngLine
End With 'MSFlexGrid1
End Sub
Private Sub Form_Resize()
Dim sngWidth As Single, sngHeight As Single
Dim sngGrdHeight As Single
Dim sngCmdHeight As Single
sngWidth = ScaleWidth
sngHeight = ScaleHeight
sngCmdHeight = 315
sngGrdHeight = sngHeight - sngCmdHeight
MSFlexGrid1.Move 0, 0, sngWidth, sngGrdHeight
Command1.Move 0, sngGrdHeight, sngWidth, sngCmdHeight
End Sub
I have a CSV file that will parse and put it to array. Note this is a big file.My questions are this how can i compute an Array in Vb6? Is it possible to have a computation in Array?
to read in a file and it in an array you can do as follows:
'1 form with
' 1 command button: name=Command1
Option Explicit
Private Sub Command1_Click()
Dim lngLine As Long
Dim intFile As Integer
Dim strFile As String
Dim strData As String
Dim strLine() As String
'select file
strFile = "c:\temp\file.txt"
'read file
intFile = FreeFile
Open strFile For Input As #intFile
strData = Input(LOF(intFile), #intFile)
Close #intFile
'put into array
strLine = Split(strData, vbCrLf)
'loop through complete array and print each element
For lngLine = 0 To UBound(strLine)
Print strLine(lngLine)
Next lngLine
End Sub
this will read in the file, put it into an array (each line with its own element), and then loop through the whole array to print each line/element on the form
[EDIT]
below is an example how to substract items from an array from corresponding items from another array:
Private Sub Command1_Click()
Dim lngIndex As Long
Dim lngA(7) As Long
Dim lngB(7) As Long
'fill the arrays
For lngIndex = 0 To UBound(lngA)
lngA(lngIndex) = lngIndex + 1
Next lngIndex
For lngIndex = 0 To UBound(lngA)
lngB(lngIndex) = (lngIndex + 1) ^ 2
Next lngIndex
'substract array a from array b
For lngIndex = 0 To UBound(lngB)
lngB(lngIndex) = lngB(lngIndex) - lngA(lngIndex)
Next lngIndex
'print arrays
For lngIndex = 0 To UBound(lngA)
Print CStr(lngA(lngIndex)) & " | " & CStr(lngB(lngIndex))
Next lngIndex
End Sub