I have a line of code saving a value to a database. The database class handles the saving of the data and is sound, the code I'm having an issue with is:
With New xdTableName
.Name = "Name"
.DayOfYear = Format(DayOfYear, "000")
.FullString = "Name" & Format(DayOfYear, "000") & Format(Number, "0000")
.Save
End With
All values for the table are saved as string, DayOfYear is an integer at first. I've tried DayOfYear.ToString.PadLeft(3, "0"c), DayOfYear.ToString("D3"), and maybe some others. Number is an integer as well and saves correctly as the left padded value of the integer it represents but for some reason DayOfYear will not save correctly. It should be saving as 012 but it only saves as 12 in both the FullString and the DayOfYear columns. Why? Even when using the same function as the Number value it still doesn't save correctly. The database column is a varchar(3) and shouldn't have any issue holding 012 as the saved data.
Your class only needs 2 properties for this example. Keep numbers as numbers, you can format them as you like when the need to be displayed.
Override ToString for the FullString and just call ToString on the xdTableName. This way, you are not storing redundant data.
Provide a parameterized constructor to easily flesh out a stable xdTableName.
Private Sub Button1_Click() Handles Button1.Click
Dim TN As New xdTableName("Name", Now.DayOfYear)
Debug.Print(TN.ToString)
TN.Save()
End Sub
Public Class xdTableName
Public Property Name As String
Public Property DayOfYear As Integer
Public Sub New(TName As String, TDay As Integer)
Name = TName
DayOfYear = TDay
End Sub
Public Overrides Function ToString() As String
Return "{Name} {DayOfYear:000}"
End Function
Public Sub Save()
'code to save
End Sub
End Class
Related
what I need does not seem to be too special, but somehow - maybe i am googling the wrong key words - I failed to find anything on the web.
How can I store variables (or references to them?) in Lists / Arrays / or something like that in a way that when I apply a change to the list the change will also be applied to the variable?
Something like:
Dim myList As New List(Of Object)
Dim a As Integer = 5
myList.Add(a)
myList(0) = 10 'here i want a to change as well
If a = 10 Then
'This is exactly what I want
Else If a = 5 Then
'This is what i don't want but what I will get
End If
So how can I accomplish this?
An integer is a value type, not a reference type like a class. You have two copies of that value, once in the list and once in the variable. If you want that behavior you needed to store a reference type in the list. For example:
Public Class MyNumber
Public Sub New(number As int32)
Value = Number
End Sub
Public Property Value As Int32
End Class
Sub Main
Dim myList As New List(Of MyNumber)
Dim myFirstNumber As New MyNumber(5)
myList.Add(myFirstNumber)
myList(0).Value = 10
' Now both, myFirstNumber.Value and myList(0).Value is 10
End Sub
I have to make a application that organizes a list of runners and their teams. In the following text file, I have to remove the top half of the text file (the top half being the listed teams) and display only the bottom half (the runners)in a listbox item.
The Text file:
# School [School Code|School Name|Coach F-Name|Coach L-Name|AD F-Name|AD L Name]
WSHS|Worcester South High School|Glenn|Clauss|Bret|Zane
WDHS|Worcester Dorehty High School|Ellsworth|Quackenbush|Bert|Coco
WBCHS|Worcester Burncoat High School|Gail|Cain|Kevin|Kane
QRHS|Quabbin Regional High School|Bob|Desilets|Seth|Desilets
GHS|Gardner High School|Jack|Smith|George|Fanning
NBHS|North Brookfield High School|Hughe|Fitch|Richard|Carey
WHS|Winchendon High School|Bill|Nice|Sam|Adams
AUBHS|Auburn High School|Katie|Right|Alice|Wonderland
OXHS|Oxford High School|Mary|Cousin|Frank|Daughter
# Roster [Bib #|School Code|Runner's F-Name|Runner's L-Name]
101|WSHS|Sanora|Hibshman
102|WSHS|Bridgette|Moffitt
103|WSHS|Karine|Chunn
104|WSHS|Shanita|Wind
105|WSHS|Fernanda|Parsell
106|WSHS|Albertha|Baringer
107|WSHS|Carlee|Sowards
108|WDHS|Maisha|Kleis
109|WDHS|Lezlie|Berson
110|WDHS|Deane|Rocheleau
111|WDHS|Hang|Hodapp
112|WDHS|Zola|Dorrough
113|WDHS|Shalon|Mcmonigle
I have some code that reads each row from the text file as an array and uses boolean variables to determine where to end the text file. This worked with displaying only the teams, which I've managed to do. But I now need to do the opposite and display only the players, and I'm a bit stumped.
My Code:
Private Sub btnLoadTeams_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoadTeam.Click
' This routine loads the lstTeam box from an ASCII .txt file
' # School [School Code | Name | Coach F-Name| Coach L-Name | AD F-Name | AD L-Name]
Dim strRow As String
Dim bolFoundCode As Boolean = False
Dim bolEndCode As Boolean = False
Dim bolFoundDup As Boolean = False
Dim intPosition As Integer
Dim intPosition2 As Integer
Dim strTeamCodeIn As String
Dim textIn As New StreamReader( _
New FileStream(txtFilePath.Text, FileMode.OpenOrCreate, FileAccess.Read))
' Clear Team listbox
lstTeam.Items.Clear()
btnDeleteRunner.Enabled = True
Do While textIn.Peek <> -1 And Not bolEndCode
Me.Refresh()
strRow = textIn.ReadLine.Trim
If Not bolFoundCode Then
If "# SCHOOL " = UCase(Mid(strRow, 1, 9)) Then
bolFoundCode = True
End If
Else
If Mid(strRow, 1, 2) <> "# " Then
For Each item As String In lstTeam.Items
intPosition = InStr(1, strRow, "|")
strTeamCodeIn = Mid(strRow, 1, intPosition - 1)
intPosition2 = InStr(1, item, strTeamCodeIn)
If intPosition2 > 0 Then
bolFoundDup = True
MsgBox("Found Duplicate School Code: " & strTeamCodeIn)
End If
Else
bolEndCode = True
Next
If Not bolFoundDup Then
lstTeam.Items.Add(strRow)
Else
lstTeam.Items.Add("DUPLICATE School Code: " & strRow)
lstTeam.Items.Add("Please correct input file and reload teams")
bolEndCode = True
End If
End If
End If
Loop
End Sub
Ive put bolEndCode = True in between the part that reads the mid section of the text file, but all Ive managed to display is the following in the listbox:
# Roster [Bib #|School Code|Runner's F-Name|Runner's L-Name]
Any help or hints on how I would display just the runners to my "lstPlayers" listbox would be greatly appreciated. I'm a beginner programmer and We've only just started learning about reading and writing arrays in my .NET class.
First I made 2 classes, one Runner and one School. These have the properties available in the text file. As part of the class I added a function that overrides .ToString. This is for he list boxes that call .ToString for display.
Next I made a function that reads all the data in the file. This is very simple with the File.ReadLines method.
Then I created 2 variables List(Of T) T stands for Type. Ours Types are Runner and School. I used List(Of T) instead of arrays because I don't have to worry about what the size of the list is. No ReDim Preserve, just keep adding items. The FillList method adds the data to the lists. First I had to find where the schools ended and the runners started. I used the Array.FindIndex method which is a bit different because the second parameter is a predicate. Check it out a bit. Now we know the indexes of the lines we want to use for each list and use a For...Next loop. In each loop an instance of the class is created and the properties set. Finally the new object is added to the the list.
Finally we fill the list boxes with a simple .AddRange and the lists.ToArray. Note that we are adding the entire object, properties and all. The neat thing is we can access the properties from the listbox items. Check out the SelectedIndexChanged event. You can do the same thing with the Runner list box.
Sorry, I couldn't just work with your code. I have all but forgotten the old vb6 methods. InStr, Mid etc. It is better when you can to use .net methods. It makes your code more portable when the boss says "Rewrite the whole application in C#"
Public Class Runner
Public Property BibNum As Integer
Public Property SchoolCode As String
Public Property FirstName As String
Public Property LastName As String
Public Overrides Function ToString() As String
'The listbox will call .ToString when we add a Runner object to determin what to display
Return $"{FirstName} {LastName}" 'or $"{LastName}, {FirstName}"
End Function
End Class
Public Class School
Public Property Code As String
Public Property Name As String
Public Property CoachFName As String
Public Property CoachLName As String
Public Property ADFName As String
Public Property ADLName As String
'The listbox will call .ToString when we add a School object to determin what to display
Public Overrides Function ToString() As String
Return Name
End Function
End Class
Private Runners As New List(Of Runner)
Private Schools As New List(Of School)
Private Function ReadData(path As String) As String()
Dim lines = File.ReadLines(path).ToArray
Return lines
End Function
Private Sub FillLists(data As String())
Dim location = Array.FindIndex(data, AddressOf FindRosterLine)
'The first line is the title so we don't start at zero
For index = 1 To location - 1
Dim SplitData = data(index).Split("|"c)
Dim Schl As New School
Schl.Code = SplitData(0)
Schl.Name = SplitData(1)
Schl.CoachFName = SplitData(2)
Schl.CoachLName = SplitData(3)
Schl.ADFName = SplitData(4)
Schl.ADLName = SplitData(5)
Schools.Add(Schl)
Next
For index = location + 1 To data.GetUpperBound(0)
Dim SplitData = data(index).Split("|"c)
Dim Run As New Runner
Run.BibNum = CInt(SplitData(0))
Run.SchoolCode = SplitData(1)
Run.FirstName = SplitData(2)
Run.LastName = SplitData(3)
Runners.Add(Run)
Next
End Sub
Private Function FindRosterLine(s As String) As Boolean
If s.Trim.StartsWith("# Roster") Then
Return True
Else
Return False
End If
End Function
Private Sub FillListBoxes()
Dim arrRunners As Runner() = Runners.ToArray
Dim arrSchools As School() = Schools.ToArray
ListBox1.Items.AddRange(arrSchools)
ListBox2.Items.AddRange(arrRunners)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim arrRunner = ReadData("Runners.txt")
FillLists(arrRunner)
FillListBoxes()
End Sub
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.SelectedIndexChanged
Dim Schl = DirectCast(ListBox1.SelectedItem, School)
TextBox1.Text = Schl.CoachLName
TextBox2.Text = Schl.Code
End Sub
I'm working on a program to parse a file name based on a drag drop, and process and remove a list of words that may be found in the file. I had the program working, but in a not so elegant manner, as well as a manner that would introduce issues later on in the program.
I'm trying create a list of a custom class or structure.
Here's what I have:
Public Class moviePath
Public currentPath As String
Public currentNameExt As String
Public currentName As String
Public currentExt As String
Public correctedName As String
Public correctYear As String
End Class
The issue is then when I attempt to create a usable variable based on this:
Dim workingList as New List(Of moviePath)
I'm left with no good way to correctly add data to the list using subs such as this:
Sub scanParent(ByVal sDir As String)
Dim f As String
Dim i As Integer = 0
Try
For Each f In Directory.GetFiles(sDir)
workingList(i).currentName = (Path.GetFileNameWithoutExtension(f))
workingList(i).currentNameExt = (Path.GetFileName(f))
workingList(i).currentPath = (Path.GetFullPath(f))
i += 1
Next
Catch excpt As System.Exception
MessageBox.Show("It didn't work " & excpt.ToString)
End Try
End Sub
Hopefully those tidbits make sense. scanParent sub is called passing the path to a folder as the argument (ie C\somefolder) and I intend to populate an array of sorts with information about files and folders. My reasoning is that I would like to be able to remove words from movie titles, in order use a opensource library (not sure if correct language) that parses IMDB to pull in movie info.
The main thing that I need is for each item in the class moviePath to be addressable and tied to each other item at that position in the list.
EDIT: ie. moviePath(0).currentPath would be in reference to the same file moviePath(0).currentName
For Each f In Directory.GetFiles(sDir)
dim info as new moviePath
info.currentName = (Path.GetFileNameWithoutExtension(f))
info.currentNameExt = (Path.GetFileName(f))
info.currentPath = (Path.GetFullPath(f))
workingList.add(info)
Next
You should be using the List(T).Add method for this.
Sub scanParent(ByVal sDir As String)
Dim f As String
Try
For Each f In Directory.GetFiles(sDir)
Dim newPath As New moviePath()
newPath.currentName = (Path.GetFileNameWithoutExtension(f))
newPath.currentNameExt = (Path.GetFileName(f))
newPath.currentPath = (Path.GetFullPath(f))
workingList.Add(newPath)
Next
Catch excpt As System.Exception
MessageBox.Show("It didn't work " & excpt.ToString)
End Try
End Sub
I agree with Plutonix. In addition to the fix by Bradley, also pass the FileName to your movePath class like this:
Public Class moviePath
Public Sub New(ByVal FullFilePath As String)
Me.currentPath = FullFilePath
Me.currentName = Path.GetFileNameWithoutExtension(FullFilePath)
Me.currentNameExt = Path.GetFileName(FullFilePath)
End Sub
Public currentPath As String
Public currentNameExt As String
Public currentName As String
Public currentExt As String
Public correctedName As String
Public correctYear As String
End Class
Now your loop becomes simply:
For Each f In Directory.GetFiles(sDir)
workingList.add(New moviePath(f))
Next
I'm designing a dynamic buffer for outgoing messages. The data structure takes the form of a queue of nodes that have a Byte Array buffer as a member. Unfortunately in VBA, Arrays cannot be public members of a class.
For example, this is a no-no and will not compile:
'clsTest
Public Buffer() As Byte
You will get the following error: "Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules"
Well, that's fine, I'll just make it a private member with public Property accessors...
'clsTest
Private m_Buffer() As Byte
Public Property Let Buffer(buf() As Byte)
m_Buffer = buf
End Property
Public Property Get Buffer() As Byte()
Buffer = m_Buffer
End Property
...and then a few tests in a module to make sure it works:
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
' Debug.Print oBuffer.Buffer(2) 'Fail
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Fail, diplays "3" in the immediate window
End Sub
Test #1 works fine, but Test #2 breaks, Buffer is highlighted, and the error message is "Wrong number of arguments or invalid property assignment"
Test #2 now works! GSerg points out that in order to call the Property Get Buffer() correctly and also refer to a specific index in the buffer, TWO sets of parenthesis are necessary: oBuffer.Buffer()(2)
Test #3 fails - the original value of 3 is printed to the Immediate window. GSerg pointed out in his comment that the Public Property Get Buffer() only returns a copy and not the actual class member array, so modifications are lost.
How can this third issue be resolved make the class member array work as expected?
(I should clarify that the general question is "VBA doesn't allow arrays to be public members of classes. How can I get around this to have an array member of a class that behaves as if it was for all practical purposes including: #1 assigning the array, #2 getting values from the array, #3 assigning values in the array and #4 using the array directly in a call to CopyMemory (#3 and #4 are nearly equivalent)?)"
So it turns out I needed a little help from OleAut32.dll, specifically the 'VariantCopy' function. This function faithfully makes an exact copy of one Variant to another, including when it is ByRef!
'clsTest
Private Declare Sub VariantCopy Lib "OleAut32" (pvarDest As Any, pvargSrc As Any)
Private m_Buffer() As Byte
Public Property Let Buffer(buf As Variant)
m_Buffer = buf
End Property
Public Property Get Buffer() As Variant
Buffer = GetByRefVariant(m_Buffer)
End Property
Private Function GetByRefVariant(ByRef var As Variant) As Variant
VariantCopy GetByRefVariant, var
End Function
With this new definition, all the tests pass!
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment on the question
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Success! Diplays "27" in the immediate window
End Sub
#Blackhawk,
I know it is an old post, but thought I'd post it anyway.
Below is a code I used to add an array of points to a class, I used a subclass to define the individual points, it sounds your challenge is similar:
Mainclass tCurve
Private pMaxAmplitude As Double
Private pCurvePoints() As cCurvePoint
Public cDay As Date
Public MaxGrad As Double
Public GradChange As New intCollection
Public TideMax As New intCollection
Public TideMin As New intCollection
Public TideAmplitude As New intCollection
Public TideLow As New intCollection
Public TideHigh As New intCollection
Private Sub Class_Initialize()
ReDim pCurvePoints(1 To 1500)
ReDim curvePoints(1 To 1500) As cCurvePoint
Dim i As Integer
For i = 1 To 1500
Set Me.curvePoint(i) = New cCurvePoint
Next
End Sub
Public Property Get curvePoint(Index As Integer) As cCurvePoint
Set curvePoint = pCurvePoints(Index)
End Property
Public Property Set curvePoint(Index As Integer, Value As cCurvePoint)
Set pCurvePoints(Index) = Value
End Property
subclass cCurvePoint
Option Explicit
Private pSlope As Double
Private pCurvature As Double
Private pY As Variant
Private pdY As Double
Private pRadius As Double
Private pArcLen As Double
Private pChordLen As Double
Public Property Let Slope(Value As Double)
pSlope = Value
End Property
Public Property Get Slope() As Double
Slope = pSlope
End Property
Public Property Let Curvature(Value As Double)
pCurvature = Value
End Property
Public Property Get Curvature() As Double
Curvature = pCurvature
End Property
Public Property Let valY(Value As Double)
pY = Value
End Property
Public Property Get valY() As Double
valY = pY
End Property
Public Property Let Radius(Value As Double)
pRadius = Value
End Property
Public Property Get Radius() As Double
Radius = pRadius
End Property
Public Property Let ArcLen(Value As Double)
pArcLen = Value
End Property
Public Property Get ArcLen() As Double
ArcLen = pArcLen
End Property
Public Property Let ChordLen(Value As Double)
pChordLen = Value
End Property
Public Property Get ChordLen() As Double
ChordLen = pChordLen
End Property
Public Property Let dY(Value As Double)
pdY = Value
End Property
Public Property Get dY() As Double
dY = pdY
End Property
This will create a tCurve with 1500 tCurve.Curvepoints().dY (for example)
The trick is to get the index process correct in the main class !
Good luck !
Not the most elegant solution, but modeling from the code you provided...
In clsTest:
Option Explicit
Dim ArrayStore() As Byte
Public Sub AssignArray(vInput As Variant, Optional lItemNum As Long = -1)
If Not lItemNum = -1 Then
ArrayStore(lItemNum) = vInput
Else
ArrayStore() = vInput
End If
End Sub
Public Function GetArrayValue(lItemNum As Long) As Byte
GetArrayValue = ArrayStore(lItemNum)
End Function
Public Function GetWholeArray() As Byte()
ReDim GetWholeArray(LBound(ArrayStore) To UBound(ArrayStore))
GetWholeArray = ArrayStore
End Function
And in mdlMain:
Sub test()
Dim buf() As Byte
Dim bufnew() As Byte
Dim oBuffer As New clsTest
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
oBuffer.AssignArray vInput:=buf
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
oBuffer.AssignArray vInput:=27, lItemNum:=2
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
bufnew() = oBuffer.GetWholeArray
Debug.Print bufnew(0)
Debug.Print bufnew(1)
Debug.Print bufnew(2)
Debug.Print bufnew(3)
End Sub
I added code to pass the class array to another array to prove accessibility.
Even though VBA won't allow us to pass arrays as properties, we can still use Functions to pick up where properties fall short.
So I am building a stock info retrieval program, and I have a good bit of it done so far. Right now I have it return the price from the Yahoo Finance API by singling out the price in the returned API data and then shove it in a listbox with the stock symbol and price. That part works great, but I want to take it a step further now and be able to do what I want with other parts of that returned data. The normal format for the data is:
"<symbol>", <price>, "<date>", "<time>", etc.
If you take a look at my code, right now I have a Getstockinfo function that retrieves the full API output and converts each object(symbol, price, etc) into a new stringbuilder line, and then separates the lines by the commas using the ModifyLine function.
I want to now get the GetStockInfo to return an array, which would allow me to use that array as I pleased outside of that function(in eventhandlers, etc.)
ANY help would be much appreciated!
Public Function GetStockInfo(ByVal pstrSymbol As String) As String
Dim strURL As String
Dim strApiOutput As String
'Yahoo API
strURL = "http://quote.yahoo.com/d/quotes.csv?" & _
"s=" & pstrSymbol & _
"&d=t" & _
"&f=sl1d1t1c1ohgvj1pp2wern"
strApiOutput = RequestWebData(strURL)
'Create stringbuilder(easier to append, replace and insert data)
Dim strReturn As New System.Text.StringBuilder
'Seperate API output into different lines by using LineFeed
For Each strLine As String In strApiOutput.Split(ControlChars.Lf)
'makes sure line actually exists, if so, seperate and add to array using ModifyLine function
If strLine.Length > 0 Then
strReturn.Append(ModifyLIne(strLine) & Environment.NewLine)
End If
Next
Return strReturn.ToString
End Function
Private Function ModifyLIne(ByVal strLine As String) As String
Dim arrLine() As String
'Splits lines by the commas(the normal api output is as follows: <Obj1>, <Obj2>, <Obj3>, etc
'with Intermediary quotes here and there for certain objects such as Company Name
arrLine = strLine.Split(","c)
decStockPrice = CDec(arrLine(1))
Return decStockPrice.ToString
End Function
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
Dim strSymbol As String = txtSymbol.Text
lstStocks.Items.Add(strSymbol.ToUpper() & " - " & GetStockInfo(strSymbol))
End Sub
I want to take it a step further now and be able to do what I want with other parts of that returned data This will do what you want, just not how you want (arrays are old-school)
Class StockQuote
Public Symbol As String
Public Price As Decimal
Public QuoteDate As DateTime
' etc
End Class
Friend myQuotes As New List(of StockQuote)
Then after you get a quote and determine you want to save it (are you saving all of them?):
Dim SQ as New StockQuote
With SQ
.Symbol = arrLine(0) ' so you can pass an array or list of ticker syms
.Price = Convert.ToDecimal(arrLine(1))
' not much sense saving Time and Date as sep items
' if you are getting multiple quotes for a day (vs ending)
.QuoteDate = combine arrline(2) and arrLine(3) ?
etc
End SQ
myQuotes.Add(SQ)
Now, myQuotes will have a list of all the quotes for all the symbols. Get them like you populated it: txtSym.Text = myQuotes(N).Symbol