Creating readonly copy of a collection in access VBA - ms-access

I am new to Access VBA and I am stuck in what I think a "Language Limitation". I have a collection of Items and I want to copy some of its items in a new collection depending on the condition and then work on that new collection. But the problem is that if I change or remove anything from that new collection, it gets changed in the previous collection also. But I dont want that to happen as it would be again used as it is in next iteration.
The code which I have used to make the new collection is:
Private Function ReturnSubCollection(TotalCollection As Collection, workIDs As String) As Collection
Dim collWorkIDs As Collection
Dim itemCount As Integer
Dim obj As Object
For itemCount = 1 To TotalCollection.count
If InStr(1, workIDs, TotalCollection.item(itemCount).Work_ID) > 0 Then
Set obj = TotalCollection.item(itemCount)
If collWorkIDs Is Nothing Then Set collWorkIDs = New Collection
collWorkIDs.Add obj
End If
Next
Set ReturnSubCollection = collWorkIDs
End Function

This is a limitation of VB. The elegant solution is to create a "memento" class in your item object as mentioned in this great answer.
A simple work around might be this:
Suppose your item class starts with three values Work_ID, Work_Name, Work_Date. Modify your code as follows:
With TotalCollection.item(itemCount)
If InStr(1, workIDs, .Work_ID) > 0 Then
Set obj = New itemClass
obj.Work_ID = .Work_ID
obj.Work_Name = .Work_Name
obj.Work_Date = .Work_Date
'And so on, for any additional fields.
If collWorkIDs Is Nothing Then Set collWorkIDs = New Collection
collWorkIDs.Add obj
End If
End With
Crude, certainly. Effective, hopefully.

Related

Access For Loop Hide Objects

I'm trying to hide/unhide around 30 objects on my form when the user selects certain values from a dropdown menu. I tried the loop below, however I receive the following error: 'Object doesn't support this property or method.' I have this code running on the 'AfterUpdate' of the dropdown menu object.
Dim VisibleVisitFields() As String
Dim VisibleVisitFieldlist As String
Dim varVisibleVisit As Variant
VisibleVisitFieldlist = "VisitDate_Event,VisitTime_Event,VisitSite_Event,VisitStaff_Event,VisitMeet_Event"
VisibleVisitFields = Split(VisibleVisitFieldlist, ",")
If (EventType = 3) Then
For Each varVisibleVisit In VisibleVisitFields
[Forms]![subFRM_TBL_Event-All in One].Controls(varVisibleVisit).visible = True
Exit For
Next
Else
If (EventType <> 3) Then
For Each varVisibleVisit In VisibleVisitFields
[Forms]![subFRM_TBL_Event-All in One].Controls(varVisibleVisit).visible = False
Exit For
Next
End If
End If
Which line triggers the error? Suspect it is reference to the subform that is flawed. Never seen code like that to loop through an array. Suggest naming subform container different from the object it holds, such as ctrEvent. What is EventType - a textbox/field on the form? Consider code:
Dim aryFields As Variant
Dim x As Integer
aryFields = Split("VisitDate_Event,VisitTime_Event,VisitSite_Event,VisitStaff_Event,VisitMeet_Event", ",")
For x = 0 To UBound(aryFields)
Me.ctrEvent.Form.Controls(aryFields(x)).Visible = Me.EventType = 3
Next
Alternative methods not using array:
Set control Tag property then code loops through all controls on form and sets visibility for those that have particular value in Tag.
Dim ctrl As Control
For Each ctrl in Me.ctrEvent.Form.Controls
If ctrl.Tag = "something" Then ctrl.Visibility = Me.EventType = 3
Next
Another is to give controls similar names, like: Visit1, Visit2, etc. Then code:
Dim x As Integer
For x = 1 to 30
Me.ctrEvent.Form.Controls("Visit" & x).Visible = Me.EventType = 3
Next
Advise no spaces or punctuation/special characters (underscore only exception) in naming convention.
You are trying to iterate over an array of strings.
Dim VisibleVisitFields() As String
You need to declare the array to contain variants (which can still contain strings)
Dim VisibleVisitFields() As Variant

Access the contents of a column in a DataTable in code

I've done research on this but none of results found does what I'm looking for.
Suppose I have a DataTable that was filled from a MySql database, in another function, I want to access one of the columns and assign the values to a variable (one at time in a loop)
Some code to illustrate what I'm trying to do:
Dim adapter As New MySqlDataAdapter
Dim dt As New DataTable
Dim intList As New List(Of Integer)
.......
.......
adapter.fill(dt)
.......
.......
dim col = dt.Columns(1)
populate the list here with the contents of the column
EDIT I am not entirely sure that Columns(1) is correct syntax
(Referring to the other answer) First, note that there is no need to separately declare scratch variables used to loop thru something. You can declare the type as part of the For...:
For Each row As DataRow In Dt.Rows
This is a more than a matter of coding style. The row variable above exists only between the For Each and Next. Declared as in the other answer, a more lengthy method can result in tmp, tmp1 etc each of a different type which were used just once for different loops.
Then, there are a number of linq methods that can get your list for you without you writing a loop at all:
Dim carbs = dt.AsEnumerable().
Select(Function(q) q.Field(Of Int32)("Carbs")).
ToList()
With Option Infer, you don't even need to declare carbs as a List(of Int32), but you can:
Dim carbs As List(Of Int32) = dt.AsEnumerable(). ...
I found what I was looking for here, I don't know how I missed that in my seach.
The code in the end is the following:
Dim carbsInvolved As New List(Of Integer)
Dim row As DataRow
For Each row In dt.Rows
carbsInvolved.Add(row.Item(1))
Next
And then the numbers in the list can be accessed by carbsInvolved.Item(index) for later use :)

"Out of stack space" with a Recursive function in vba for Access

I'm reaching out to you because I'm getting troubles coding a module for an Access program.
Introduction:
I got 4 Tables: Products, Receipes, Ordonnancement & Commands.
Ordonnancement and Commands have the same structure, the second one being the result of the processing of the commands through the receipes.
Goal of the VBA Module:
I'm creating a Module to create records to the Ordonnancement table by processing the commands through the receipes. In detail, I use a recursive function to cope with the variable deepth of the receipes that allows me to loop through the Receipes Table and generate the need in all Products for one date.
Remarks:
-I normally work in C# using EF to work with databases. After several tries to use directly the RecordSet possibilities of Access, I decided to generate POCO classes for ReceipeLign and OrdoLign, to stock the data of the tables in collections of those objects, work with those and then commit to the Access tables adding records to each RecordSet.
-I work in french, so I translated a few things so it can be understood by everyone. It might not be perfect, let me know if not clear.
Code:
Option Compare Database
Option Explicit
Dim cnc As New ADODB.Connection
Dim CRecordSet As New ADODB.Recordset
Dim FTRecordSet As New ADODB.Recordset
Dim ORecordSet As New ADODB.Recordset
Public Sub GenerateOrdonnancement()
'Retrieving info from tables Commandes & FT in RecordSets.
Set cnc = CurrentProject.Connection
Set CRecordSet = cnc.Execute("SELECT * FROM Commandes")
Set FTRecordSet = cnc.Execute("SELECT * FROM FichesTechniques")
Set ORecordSet = cnc.Execute("SELECT * FROM Ordonnancement")
'Creation of the list to receive data from the tables
Dim Commandes As New Collection
Dim FicheTechniques As New Collection
'Retrieving commands and receipes
Dim Commande As ligneOrdo
Dim ordo As ligneOrdo
Dim FT As ligneFT
Do Until CRecordSet.EOF
Set Commande = New ligneOrdo
Commande.DateCommande = CRecordSet("dateCommande").Value
Commande.Produit = CRecordSet("Produit").Value
Commande.Quantite = CRecordSet("quantite").Value
Commandes.Add Commande
CRecordSet.MoveNext
Loop
CRecordSet.Close
Do Until FTRecordSet.EOF
Set FT = New ligneFT
FT.Nom = FTRecordSet("Nom").Value
FT.Ingredient = FTRecordSet("Ingredient").Value
FT.Quantite = FTRecordSet("quantité").Value
FT.IsComposed = FTRecordSet("Composé").Value
FicheTechniques.Add FT
FTRecordSet.MoveNext
Loop
FTRecordSet.Close
'creation of the collection of ordo
'Later: versionning of the Ordonnancements
Dim AProduire As New Collection
Dim mr As ligneOrdo
For Each mr In Commandes
Dim coll As Collection
Set coll = CreateOrdoLigne(mr, FicheTechniques)
Dim item As New ligneOrdo
For Each item In coll
AProduire.Add item
Next item
Next mr
'Adding and saving the coll AProduire in the RecordSetO
cnc.BeginTrans
Dim item2 As ligneOrdo
For Each item2 In AProduire
ORecordSet.AddNew
ORecordSet("DateCommande").Value = item2.DateCommande
ORecordSet("Produit").Value = item2.Produit
ORecordSet("Quantite").Value = item2.Quantite
ORecordSet.Update
Next item2
ORecordSet.Close
cnc.CommitTrans
End Sub
Function CreateOrdoLigne(ligne As ligneOrdo, FT As Collection) As Collection
Dim ordo As New Collection
Dim ligneFT As Variant
'Loop through the receipes
For Each ligneFT In FT
If ligneFT.Nom = ligne.Produit Then
Dim AProduire As New ligneOrdo
AProduire.Produit = ligneFT.Ingredient
AProduire.DateCommande = ligne.DateCommande
AProduire.Quantite = ligne.Quantite * ligneFT.Quantite
ordo.Add AProduire
If ligneFT.IsComposed = True Then
Dim ordoList2 As New Collection
Set ordoList2 = CreateOrdoLigne(AProduire, FT)
Dim recordOrdo As ligneOrdo
For Each recordOrdo In ordoList2
ordo.Add recordOrdo
Next recordOrdo
Set ordoList2 = Nothing
End If
Set AProduire = Nothing
End If
Next ligneFT
Set CreateOrdoLigne = ordo
End Function
Problem Statement:
Running the Module, I get a Run-Time Error 28 : "Out of stack Space", which seems after some reseach a common thing working with recursive functions in such tight environnements. Problem is, I can't really optimize the process. I am looking for direct ways to bypass this error or ideas to tackle this problem in another way.
Thank you all,
So after some debuging with #Andre 's help, I found out that the recursivity was infinite, hence the error on the size.
Even with that, Access was not able to generate so much data and stock it somewhere beforme commiting those changes to the database.
I have found a way around that problem, which consists in:
avoiding using functions to be stocked in a collection. I therefore transformed the function into a sub.
commiting the changes to the database along the generation process.
obj = Nothing when it is not needed anymore in a repeatable process.
What I have learnt and maybe could help others
Analyse the recursive process to see what could make it infinite, define error handlers accordingly
Debug.Print is an efficient way to debug in vba ACCESS, to generate data and check the whole process.
Thank you #Andre and the others for your time, hope it will help others.

VB.Net "mask" combo box text as another text

So I have a combobox which contains table names from a MySql database they are automatically listed using show tables query upon form load.
Is there anyway to show something else in the combobox but the text value still being the original table name?
It isn't impossible. Here is a trivial example:
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' This would be whatever you are pulling from the database. For the purpose of this example, it is just mock data.
Dim dataFromDatabase As IEnumerable(Of String) = {"1st table from db", "2nd table from db", "etc."}
' What you actually want to display in the combobox. It should be in the same order as above and have the same number of items. Items must be unique.
Dim valuesToDisplayInComboBox As IEnumerable(Of String) = {"1st item", "2nd item", "3rd item"}
' This is what ties the two together. You would probably want this to be larger in scope than this example.
Dim dataCollection As New Dictionary(Of String, String)
For i As Integer = 0 To dataFromDatabase.Count - 1 Step 1
dataCollection.Add(valuesToDisplayInComboBox(i), dataFromDatabase(i))
Next
ComboBox1.DataSource = valuesToDisplayInComboBox
End Sub
End Class
Now you have a Dictionary that links the 2 together, so whenever the user selects something in the combobox, you would go to the Dictionary and look up the corresponding table name.
Class Element
Public ItemName as String = ""
Public ItemData As Object = Nothing
' Object allows it to be reusable beyond this use
Public Sub New(iName as String, iData As Object)
ItemName = iName
ItemData = iData
End Sub
Public overrides Function ToString As String
Return ItemName
End sub
End Class
....
For each s as string in listoftablesfromdatabase
' dont know how you are getting your list,
' but here is one way to alias them
Dim El as Element
Select Case s
Case "tbl_event_birthdays_september"
El = New Element("September Birthdays", s)
case ...
case ...
End Select
ComboBox1.Items.Add(el)
Next s
The class will automatically use the friendly name you gave it. To get the real selected item name:
realName = ComboBox1.SelectedItem.ItemData.Tostring
might not need the .ToString This is not a lot different than Douglas Barbin's idea, it still associates 2 strings, it just doesnt use a dictionary. Alternatively, you could store the Elements in a List(of Element) or Dictionary and bind it to the datasource as Douglas showed.
If the user comes back to the Combo over and over, then do use a List or Dictionary, but not temporary - build it once and use it over and over.

Returning Multiple Values from a Custom Function

So, I've got a ValidateForm function that loops through a form to validate each control. I have a collection set up called ValData to capture different bits of info to be passed out of the function. This is working great.
However, I don't know how to access each item in ValData after the function returns. I can get one at a time like: ValidateForm().IsValid, but in order to get each item, I have to run the function again. I want to avoid this.
Is there a way to run the function once, but access the values of each item returned?
Depending upon your requirements (which are NOT clear in your question! ;-) ), you might consider using a Collection as the return from your function:
Private Function MyResultsFunction() As Collection
Dim output As Collection
Set output = New Collection
'Hydrate your collection with data by whatever means necessary:
With output
'Stupid example code:
.Add "Item1"
.Add "Item2"
.Add "Item3"
.Add "Item4"
End With
'Return a reference to the collection as the function output:
Set MyResultsFunction = output
End Function
As a simple, retarded test of the above:
Private Sub Form_Load()
'A variable to receive the results from your function:
Dim Results As Collection
'An iterator to loop through the results contained in the collection:
Dim CurrentItem As Variant
'For this example, a string to toss the results into to display in the
'MsgBox:
Dim output As String
'Use the local Collection defined above to access the reference returned by
'your function:
Set Results = MyResultsFunction
'Iterate through the collection and do something with the results
'per your project requirements:
For Each CurrentItem In Results
'This is stupid example code:
output = output & CurrentItem & vbCrLf
Next
'I am just displayng the results to show that it worked:
MsgBox output
'Clean up:
Set Results = Nothing
End Sub
Hope that heps!
Without seeing your code it's hard to say what exactly you are tyring to do, but here is one of several ways you can store results to query later.
Declare a public variable at the top of your module to represent the items from your ValData function. After you populate the array, you can access the items through a normal function.
You obviously could do more sophisticated things, especially if you use a collection object. You could even store a counter and create a GetNext() function. I hope this gives you a heads start.
Public Results(1 To 2) As String
Sub CreateTestArray()
Results(1) = "Foo"
Results(2) = "Bar"
End Sub
Function GetResult(ByVal i As Long) As String
If i <= UBound(Results) Then
GetResult = Results(i)
End If
End Function
Sub ProofOfConcept()
MsgBox GetResult(2) ' will show "Bar"
End Sub