I have an issue when populating a collection in VBA in MS Access.
Here's the code I have:
Private Sub loadInfo()
Dim sql As String
sql = "SELECT * FROM table2';"
Set db = CurrentDb
Set rs = db.OpenRecordset(sql)
With rs
.MoveFirst
While rs.EOF = False
Dim person As New person
Dim idToString As String
idToString = rs.Fields("ID").value
person.setFirstName (rs.Fields("first_name").value)
person.setLastName (rs.Fields("last_name").value)
people.Add person, idToString
.MoveNext
Wend
End With
End Sub
The collection is declared an initialized at the top of the class module. I can add items to it just fine. However, at the end of the Sub, I end up with a collection with the right amount of objects (however many I have in the Recordset,) but all of them with the same firstName and lastName.
Now, I thought that every time the "when" loop goes 'round, the variables inside of it would go out of scope, thus becoming null. In this case, that does not seem to be the case. Every time it gets back to person.setFirstName, the firstName of the item already in the collection changes to whatever the current firstName of the new row is. The same goes for lastName.
This leads me to believe that person is not being created every time the loop goes 'round, giving me a collection of similar entries, aside from their key which is unique.
Any ideas as to how to get the loop to perform as it should?
A collection is key-value paired list. It cannot have multiple dimensions.
Try using User Defined Types:
In module declarations...
Public Type Person
FirstName As String
LastName As String
End Type
In form declarations...
Dim typPerson() As Person
Then use like this...
ReDim typPerson(0 To rs.RecordCount - 1) As Person
Dim i As Integer
Do While Not rs.EOF
With typPerson(i)
.FirstName = rs!FirstName
.LastName = rs!LastName
End With
i = i + 1
rs.MoveNext
Loop
In your sub loadinfo(), insert the line:
“Set Person=Nothing”, before
“.MoveNext”.
If you don’t, the same item gets added to the collection the whole time.
HTH
Related
I have two datatables, one of them is populated when application starts and the other one is populated on button click. How can i check (fastest way) if anything changed in second datatable?
I have tried this but it does not work:
For Each row1 As DataRow In dtt.Rows
For Each row2 As DataRow In dtt1.Rows
Dim array1 = row1.ItemArray
Dim array2 = row2.ItemArray
If array1.SequenceEqual(array2) Then
Else
End If
Next
Next
The problem is that your loops are nested. This means that the inner For Each loops through each row of dtt1 for each single row of dtt. This is not what you want. You want to loop the two tables in parallel. You can do so by using the enumerators that the For Each statements use internally
Dim tablesAreDifferent As Boolean = False
If dtt.Rows.Count = dtt1.Rows.Count Then
Dim enumerator1 = dtt.Rows.GetEnumerator()
Dim enumerator2 = dtt1.Rows.GetEnumerator()
Do While enumerator1.MoveNext() AndAlso enumerator2.MoveNext()
Dim array1 = enumerator1.Current.ItemArray
Dim array2 = enumerator2.Current.ItemArray
If Not array1.SequenceEqual(array2) Then
tablesAreDifferent = True
Exit Do
End If
Loop
Else
tablesAreDifferent = True
End If
If tablesAreDifferent Then
'Display message
Else
'...
End If
The enumerators work like this: They have an internal cursor that is initially placed before the first row. Before accessing a row through the Current property, you must move to it with the MoveNext function. This function returns the Boolean True if it succeeds, i.e. as long as there are rows available.
Since now we have a single loop statement and advance the cursors of enumerator1 and enumerator2 at each loop, we can compare corresponding rows.
Note that the Rows collection implements IEnumerable and thus the enumerators returned by GetEnumerator are not strongly typed. I.e. Current is typed as Object. If instead you write
Dim enumerator1 = dtt.Rows.Cast(Of DataRow).GetEnumerator()
Dim enumerator2 = dtt1.Rows.Cast(Of DataRow).GetEnumerator()
Then you get enumerators of type IEnumerator(Of DataRow) returning strongly typed DataRows.
Not sure if this is even possible but I need to be able to pass a variable's value in as an object's member name.
Basically I'm using a wdsl that has a number of objects where some of them could contain a collection, I need to make data grids to show the data in the collection which is straightforward enough but at the moment I have to make code for each object/collection that defines how many effective columns and their names and types.
This works fine albeit a bit long winded but it will also break if the wdsl changes and the objects collection content changes (names, types etc.)
What I need is to be able to pass a object name to a sub which will work out if the object contains a collection (PropertyType will contain []), read its name and pass that name down to a loop which will go through at the correct level to retrieve the "column" names and data types.
I have got almost all of this working until I want to pass the collection name into a loop as an object member name as it obviously doesn't evaluate the string value of CollName in the below example, it will just error saying CollName isn't a member of the object which of course it isn't but the variables actual value would be.
Sub IterateObject(objName)
Dim CollName = ""
For Each m As System.Reflection.PropertyInfo In objName.GetType().GetProperties()
If m.CanRead Then
If InStr(m.PropertyType.ToString, "[]") <> 0 Then
CollName = m.Name
End If
End If
Next
For Each p As System.Reflection.PropertyInfo In objName.CollName(2).GetType().GetProperties()
If p.CanRead Then
If p.Name <> "ExtensionData" Then
MsgBox(p.Name & " - " & (p.PropertyType.ToString))
End If
End If
Next
End Sub
Is there a way of doing effectively objName.(value of CollName)(2).GetType().GetProperties()
This seems to have fixed it using CallByName to allow me to make a new object out of just the bit I need
Sub IterateObject(objName)
Dim CollName = ""
For Each m As System.Reflection.PropertyInfo In objName.GetType().GetProperties()
If m.CanRead Then
If InStr(m.PropertyType.ToString, "[]") <> 0 Then
CollName = m.Name
End If
End If
Next
Dim CollObj
CollObj = CallByName(objName, CollName, CallType.Get)
For Each p As System.Reflection.PropertyInfo In CollObj(0).GetType().GetProperties()
If p.CanRead Then
If p.Name <> "ExtensionData" Then
MsgBox(p.Name & " - " & (p.PropertyType.ToString))
End If
End If
Next
End Sub
I'm wondering if anyone can help me. I'm trying to populate a public dictionary from a recordset returned from an sql table.
It all seems to work fine, except one part. I don't know if it's not counting the number of keys in the dictionary correctly, or they aren't being entered correctly but for whatever reason when I try and show the total count, it always comes back with only 1 (supposed to be around 15) and only displays the first row details.
Can anyone help?
Public UserList As New scripting.Dictionary
Sub UserDL()
Dim USList As Range
Dim USArr(0 To 11) As Variant
Call ConnecttoDB
Set Cmd = New adodb.Command: Set rs = New adodb.Recordset
With Cmd
.CommandTimeout = 30
.ActiveConnection = cn
.CommandText = "CSLL.DLUsers"
Set rs = .Execute
End With
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
For i = 1 To 11
USArr(i - 1) = rs(i)
Next i
With UserList
If Not .Exists(rs("Alias")) Then
.Add Key:=rs("Alias"), Item:=USArr
End If
End With
.MoveNext
Wend
End If
End With
IA = UserList.Items
Debug.Print UserList.Count & " Items in the dictionary"
For Each element In IA
For i = 0 To 10
Debug.Print element(i)
Next i
Next element
Set Cmd = Nothing: Set rs = Nothing ': Set UserList = Nothing
End Sub
rs("Alias") is a Field object. The default property for a Field object is Value, so normally just referring to the Field object gives us what we want - the value. However, a Dictionary can store objects (as the value or the key), so when you add an object it actually stores the object rather than the default property. So in your code, you add rs("Alias") as a key, i.e. the object and not the value. When you move to the next record, rs("Alias") is still the same object - only the value has changed. Therefore when you check if the key exists, it does. You need to add the Value property as the key.
The reason aa_dd's answer works is because it stores the value in a variable and then uses that value as the key, i.e. not the Field object.
An alternative approach is to explicitly use the Value property of the Field object...
With UserList
If Not .Exists(rs("Alias").Value) Then
.Add Key:=rs("Alias").Value, Item:=USArr
End If
End With
store rs("Alias") in a variable and then use that variable as key.
dim sKey as String
With UserList
sKey=rs("Alias")
If Not .Exists(sKey) Then
.Add sKey,USArr
End If
End With
I am making a dvd database system in windows form and trying to display the dvd's entered by a user. Then display the Title, Director and Genre in 3 separate listBoxes.
When the user enters the information through 3 separate text boxes, the information is stored in a structure I made called TDvd. This means I can call for example dvd.Title or dvd.Director. I also use the variable index to add this information to an array I made called Dvd(100) (just a random number I used to test).
Here is the code I currently have for adding the items to the ListBox:
For i = 1 To noOfAddedDvds
lstTitle.Items.Add(dvd(i).Title)
lstDirector.Items.Add(dvd(i).Director)
lstGenre.Items.Add(dvd(i).Genre)
Next
The variable NoOfDvdsAdded is just a way of keeping track of the number of dvd's the user has already entered.
I run this and enter the Title, Director and Genre, but when I try and display this information across the 3 listboxes, I get the error:
An unhandled exception of type 'System.ArgumentNullException' occurred in System.Windows.Forms.dll
Public Class Form1
Structure TDvd
Dim Title As String
Dim Director As String
Dim Genre As String
End Structure
Dim dvd(100) As TDvd
Dim index As Integer = 0
Dim noOfAddedDvds As Integer
Private Sub btnAddToDatabase_Click(sender As Object, e As EventArgs) Handles btnAddToDatabase.Click
If txtDirector.Text <> "" Or txtGenre.Text <> "" Or txtTitle.Text <> "" Then
txtTitle.Text = dvd(index).Title
txtDirector.Text = dvd(index).Director
txtGenre.Text = dvd(index).Genre
index += 1
noOfAddedDvds += 1
End If
End Sub
Private Sub btnDisplayDatabase_Click(sender As Object, e As EventArgs) Handles btnDisplayDatabase.Click
Dim i As Integer
For i = 0 To noOfAddedDvds
MessageBox.Show(index & ", " & i)
lstTitle.Items.Add(dvd(i).Title)
lstDirector.Items.Add(dvd(i).Director)
lstGenre.Items.Add(dvd(i).Genre)
MessageBox.Show(index & ", " & i)
Next
End Sub
End Class
According to the documentation, an ArgumentNullException is thrown by the Add() method if the argument passed to it is null. (Or Nothing in VB.) So one of these is Nothing at runtime:
dvd(i).Title
dvd(i).Director
dvd(i).Genre
You'll have to debug to determine which. It would seem that the error is because you're starting your iteration at 1 instead of 0, I would think it should be:
For i = 0 To noOfAddedDvds - 1
So when you get to the index of noOfAddedDvds in your collection, that element will be an uninitialized struct with Nothing strings.
You'll definitely want to fix the iteration (indexes start at 0). Additionally, you may also benefit from initializing the String properties in your struct to String.Empty internally. Depends on whether you want similar errors to manifest as an exception or as an empty record. Sometimes the latter makes the problem more obvious since at runtime you'd see that your output started on the second record.
Just a few pointers...
The Items collection on the ListBox is actually 0 indexed, by which I mean that instead of going "1,2,3", it actually goes (0,1,2).
That's what your problem is.
Hint - think about perhaps using a List instead of an array as well... (for dvd)
Your thing cries out for being rewritten in OO form:
Friend DVDGenres
Undefined
Comedy
Action
Adventure
Sci-Fi
End Enum
Friend Class DVD
Public Property Title As String
Public Property Director As String
Public Property Genre As DVDGenres
Public Sub New
Title = ""
Director = ""
Genre = DVDGenres.Undefined
' other stuff too
End Sub
Public Overrides Function ToString As String
Return Title
End Sub
End Class
Now something to store them in. Arrays went out with Rubik's Cubes, so a List:
Private myDVDs As New List(of DVD)
A list and a class can do what arrays and structures can without the headaches. Add a DVD:
Dim d As New DVD
d.Name = TextBoxName.Text
d.Director = TextBoxDir.Text
d.Genre = comboboxGenre.SelectedItem
' add to the container:
myDVDs.Add(d)
Display all the DVDs in a ListBox to pick from:
AllDVDsLB.DataSource = myDVDs
AllDVDsLB.DisplayMember = "Title"
This will set your list as the datasource for the listbox. Whatever is in the List is automatically displayed without copying data into the Items collection. Then, say from selectedindex changed event, display the selected item details to some labels:
Label1.Text = Ctype(AllDVDsLB.SelectedItem, DVD).Title
Label2.Text = Ctype(AllDVDsLB.SelectedItem, DVD).Director
Label3.Text = Ctype(AllDVDsLB.SelectedItem, DVD).Genre.ToString
Iterate to do something like what is in the Question:
For Each d As DVD in myDVDs ' CANT run out of data
lstTitle.Items.Add(d.Title)
lstDirector.Items.Add(d.Director)
lstGenre.Items.Add(d.Genre.ToString)
Next
Or iterate and reference with an Int32:
For n As Integer = 0 To myDVDs.Count - 1
lstTitle.Items.Add(myDVDs(n).Title)
' etc
Next n
HTH
I'm new to VBA and i need help.
I want to create vba function which takes table name as input, and distinct specific field from that table. I created function, and it works when i run it in vba immediate window (when i use debug.print command to display results). But when i call this function in sql, instead whole field values, it returns just last one. I'm not good at vba syntax so i need help to understand. Does function can return more than one value? If can, how, and if not what else to use? Here's my code:
Public Function TableInfo(tabela As String)
Dim db As Database
Dim rec As Recordset
Dim polje1 As Field, polje2 As Field
Dim sifMat As Field, pogon As Field, tipVred As Field
Set db = CurrentDb()
Set rec = db.OpenRecordset(tabela)
Set sifMat = rec.Fields("Field1")
Set pogon = rec.Fields("Field2")
Set tipVred = rec.Fields("Field3")
For Each polje1 In rec.Fields
For Each polje2 In rec.Fields
TableInfo = pogon.Value
rec.MoveNext
Next
Next
End Function
Any help is appreciated.
The problem is with this line probably:
TableInfo = pogon.Value
It runs inside the loop and returns the last value of the loop.
Instead of returning one value TableInfo, you may try to return something similar to a Collection or an Array.
Inside the loop, append values in the Collection and after the loop, return the Collection back from the function.
Edit:
I have re-written the code shared by you:
Public Function TableInfo(tabela As String) as String()
Dim db As Database
Dim rec As Recordset
Dim polje1 As Field, polje2 As Field
Dim sifMat As Field, pogon As Field, tipVred As Field
Dim returnValue() As String
Dim i as Integer
Set db = CurrentDb()
Set rec = db.OpenRecordset(tabela)
Set sifMat = rec.Fields("Field1")
Set pogon = rec.Fields("Field2")
Set tipVred = rec.Fields("Field3")
' I am not going to modify this but I think we can do away with two For Each loops.
' Just iterate over rec like
' For Each r In rec -> please use proper naming conventions and best practices
' and access each field as r("Field1") and r("Field2")
For Each polje1 In rec.Fields
For Each polje2 In rec.Fields
returnValue(i) = pogon.Value
i = i + 1
rec.MoveNext
Next
Next
TableInfo = returnValue
End Function
Please note: I have not tested this code but I assume this should work for you. Also, I have assumed that you want to return String() array. Please change the data type if you want to return some other type.
When you call the array (as posted in theghostofc's answer), you will need to do something like this:
Dim TableInfo() As String
For i = LBound(TableInfo) To UBound(TableInfo)
YourValue = TableInfo(i)
... Process some code that uses YourValue
Next i
If you're not looping through your array, you're not going to get each individual value out of it.