Specific question about collections in VBA / Access

[OsheRono]

Hello,

I have been trying to migrate some code I have written so I can use the advantages of Collection items in several forms I programmed in Access 2002. I was using an array list to collect information from a machine part and its resulting defect, then display a small summary of all parts as well as general information about the machine being repaired.

Now, most of the transition has gone without problems, however, I have hit a snag. When I try to list the collection items in the textbox, they reuse to list correctly. Here is the code I have done (displays information, just not how I want it)

[code]

Public Function creer_liste_piece_defaut(x As Integer)

'If condition: Si c'est la première fois que on fait appel à a fonction (controllé par les variables)
'la première condition est effectué. Sinon, la liste type "array" est augmentée en taille, tout en preservant
'les valeurs déjà entreés. La taille de cette liste est établit par la fonction qui fait appel à elle.
Dim y As Integer

'Création de la liste
'On s'arrete quand le nombre maximal de pieces est achevé
Do Until x > PieceDefaut.Count - 1
y = x + 1
If (est_Compresseur = True) Then
txtPieceDefaut = txtPieceDefaut & "---------------------" & vbCrLf & "Pièce: " & PieceDefaut.Item(x) & vbCrLf & _
"Défaut: " & PieceDefaut.Item(y) & vbCrLf & ""
'txtPieceDefaut = txtTransition & txtPieceDefaut
End If
If (est_Rechauffeur = True) Then
txtPieceDefaut = txtPieceDefaut & "" & vbCrLf & "Symbole: " & PieceDefaut.Item(x) & vbCrLf & "Défaut: " & _
PieceDefaut.Item(y) & vbCrLf & " --------------o------------" & vbCrLf & ""
End If
x = x + 2
Loop
End Function
[icode]

Where PieceDefaut is the collection, and txtPieceDefaut is the string that contains the data outputted to the textbox. Now if I remove the txtPieceDefaut right after the = sign, all it does is display the current item being manipulated (when I use debug.print it display all the items, however), but if I leave it as it is, then it displays the information this way:

Sample output:

L'information suivant sera enregistrée dans la base de données:
Utilisateur: Bruno
Date d'intervention: 22/04/2011
Compresseur: 12/12
---------------------
Pièce: CLAPET <----The first item is repeated twice
Défaut: CASSE AVANT
---------------------
Pièce: CLAPET
Défaut: CASSE AVANT
--------------------- <---If I add another item, then ALL this
Pièce: STATOR is copied and displayed along with the new
Défaut: DEFAUT D ISOLEMENT item.

I have tried several "solutions" but all seem to only compound the problem, not fix it. What I was thinking (since I need the collection to allow users to delete data from it or modify before saving the machine repair data to the database, with the array I just had them reset all and start over, but that is not very productive in the long run) of doing was to use the collection.items property to assign it to an array, then display the array in the textbox, then manipulate the collection as so, then when I update the information, transform it to an array, rinse and repeat... yet this seems like a redundant way to do it. And I'm not sure if it will work (writing it as we speak).

I am open to suggestions, thanks in advance!

[AndreRet]

Your post is somewhat confusing, especially being in french. I hope that I have assumed the following correctly. Please let me know if not.

Firstly I think that a listbox will work much better, because you can control the listbox listindex when adding or deleting data. Look at the code below and let me know if this is working for you. I have added '.Text' to your textbox calls, changed your loop to a for next and lastly removed the x jumping/skipping a record 'x = x + 2.

Public Function creer_liste_defaut()

Dim x As Integer, y As Integer

For x = 0 To PieceDefaut.Count - 1 'Use a for next loop
    y = x + 1 'Getting the following records number?
    
    If est_Compesseur = True Then
        txtPieceDefaut.Text = txtPieceDefaut.Text & "-------" _
        & vbCrLf _
        & "Piece: " _
        & PieceDefaut.Item(x) _
        & vbCrLf _
        & "Defaut: " _
        & PieceDefaut.Item(y) _
        & vbCrLf _
        & "."
    ElseIf est_Rechauffeur = True Then
        txtPieceDefaut.Text = txtPieceDefaut.Text _
        & "" _
        & vbCrLf _
        & "Symbole: " _
        & PieceDefaut.Item(x) _
        & vbCrLf _
        & "Défaut: " _
        & PieceDefaut.Item(y) _
        & vbCrLf _
        & " --------------o------------" _
        & vbCrLf _
        & ""
    End If
Next x 'Why do you need to skip a record by using x = x + 2?

'I personally think that by using a listbox will solve your problem MUCH better.
'Have you tried using a listbox?
End Function

[OsheRono]

I have x = x + 2 Because it is a do until loop. So X must increase by two because the collection is organised as piece/defaut/piece/defaut and so on; each pair has a piece and its corresponding defect. I have tried a list box, it was one of the very first things I tried, but it just didn't want to display anything than the first line (I had to manually click then it would show). I don't have the code experience to format a listbox to what I wanted either, since this is an internship job, I'm working on getting the core functions working (they asked me to have it display the data before they could save it, I'm trying to have it be able to modify the data as well before it's entered, but an array complicated things unnecessarily). I'll give this a try after I have sorted out the ADO connection settings on this beast.

Edit: I have been using Option Base 1 in order to make future code upgrades and modifications easier (the person who will have the source code is not a programmer), should I keep it this way or adapt the for loop?

Edit: I just remembered, I did try something similar to this, it didn't work. The data in the collection is organized like this

1 Piece
2 Defaut
3 Piece
4 Defaut
5 Piece
6 Defaut .... and so on

So if I use for each, I would have piece/defaut the first time, then defaut/piece the second, then piece/defaut the third, defaut/piece the fourth well you get the idea. And I would still suffer from the string containing the "history" of each previous list (Having the third iteration, for example, contain the text of the first string, then repeated along with the text of the second string, then repeated along with the text of the third, see output in my first post to get the idea)...

[AndreRet]

Am I correct in assuming that you have 2 tables in your dataset, one with field "Piece", and one with field "Defaut"? You are then trying to add the records together under one heading as in "Piece = This, and Defaut = that" and then continue to the next piece and defaut. If they are in seperate tables, different code than if they would have been in the same.

Send me a sample of your structure and I will show you how to use the listbox, save the data to a new table (?assuming it goes to a new table?) with the connections.

Also mention what database you are using, MySql, MS Sql, Access etc.

[OsheRono]

Well I am working with Access 2002, in the mdb format. The information for each piece and its corresponding defect are stored within two small tables providing the information to two combo boxes in a form. The pieces, and the defects, are small in number, and when the user chooses them, they are stored in values(a variable). Now this information is stored into an actual table, which contains the columns "Pieces" and "défaut" (defects), this table is linked to other tables to that when the user saves the information, the database contains:

Machine type
Date of repairs
Piece type/ Corresponding defect

There can be only one type of machine, however a machine can have more than one piece being repaired, of which some pieces can have two or more components damaged (hence the original array I used).

Now this is simple enough, however, I have been asked to display the information being entered dynamically (hence the textbox), which I succeeded in doing. I decided to add further functionality though, and allow the user to edit information entered before saving it, instead of deleting all and starting over. I have a fairly good idea how to do this via c# (listbox wise), but vba is, well its different in some aspects I guess. I'm not sure I answered your information request, let me know if it is lacking.

[AndreRet]

Ok, I have put a sample together for you, see attached. You will see that I have not combined your pieces and defects together, because thia will result in problems if more that one defect is found on a part.

You can also add the parts and defects to a listbox. You need to add some code if you would like to work with data from the listbox. Let me know if you need help there.

You will also note that there is not much comments in the code, rushed your sample within an hour...

Read the comments that is there though.

Good luck. Let me know if this is what you needed.

[OsheRono]

Hmm this are VB 6.0 files, aren't they? I'll have to wait until I get home to open them I don't have access to VB 6 over here... thanks though!

[AndreRet]

My apologies for thinking that you required code in vb6. Seems that you need for vba. Have a look at the sample and see if it can be incorporated into vba. There should not be a problem there. Below is the code from sample, see if it will help -

Option Explicit

'Reference MS ActiveX Data Objects Library 2.8 under references BEFORE
'running code

'This also does not cover for errors as in no text added to a textbox etc.
'You still need to trap for errors yourself.

'There is also no comments added, I assume that you know the basics around this code
'coming from C#

'If you need any info on any code, post in Daniweb and we will follow up from there.

Private Sub ClearTextboxes(frm As Form)

Dim Control As Control

For Each Control In frm.Controls
    If TypeOf Control Is TextBox Then
        Control.Text = ""
    End If
Next Control
End Sub

Private Sub LoadData()

On Error Resume Next

'Add proper error trapping code here. The error that will most probably
'be raised will be if there is no recordset to load, in other words
'BOF or EOF = True

Dim conData As ADODB.Connection
Dim rsMachine As ADODB.Recordset
Dim rsParts As ADODB.Recordset
Dim rsDefects As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsMachine = New ADODB.Recordset
Set rsParts = New ADODB.Recordset
Set rsDefects = New ADODB.Recordset
    
rsMachine.Open "SELECT * FROM Machines ORDER BY MachineName", conData, adOpenStatic, adLockOptimistic

rsMachine.MoveFirst

txtMachineNumber.Text = rsMachine!MachineNumber
txtMachineName.Text = rsMachine!MachineName

rsParts.Open "SELECT * FROM Parts ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsParts.MoveFirst

txtPartNumber.Text = rsParts!PartNumber
txtPartName.Text = rsParts!PartName
txtMachineParts.Text = rsParts!MachineName

rsDefects.Open "SELECT * FROM PartDefects ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsDefects.MoveFirst

txtPartNum.Text = rsDefects!PartNumber
txtPartNames.Text = rsDefects!PartName
Def1.Text = rsDefects!Defect1
Def2.Text = rsDefects!Defect2
Def3.Text = rsDefects!Defect3
Def4.Text = rsDefects!Defect4
Def5.Text = rsDefects!Defect5

rsMachine.Close
rsParts.Close
rsDefects.Close
conData.Close
End Sub

Private Sub MoveNextData()

On Error Resume Next

'Add proper error trapping code here. The error that will most probably
'be raised will be if there is no recordset to load, in other words
'BOF or EOF = True

Dim conData As ADODB.Connection
Dim rsMachine As ADODB.Recordset
Dim rsParts As ADODB.Recordset
Dim rsDefects As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsMachine = New ADODB.Recordset
Set rsParts = New ADODB.Recordset
Set rsDefects = New ADODB.Recordset
    
rsMachine.Open "SELECT * FROM Machines ORDER BY MachineName", conData, adOpenStatic, adLockOptimistic

rsMachine.MoveNext

txtMachineNumber.Text = rsMachine!MachineNumber
txtMachineName.Text = rsMachine!MachineName

rsParts.Open "SELECT * FROM Parts ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsParts.MoveNext

txtPartNumber.Text = rsParts!PartNumber
txtPartName.Text = rsParts!PartName
txtMachineParts.Text = rsParts!MachineName

rsDefects.Open "SELECT * FROM PartDefects ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsDefects.MoveNext

txtPartNum.Text = rsDefects!PartNumber
txtPartNames.Text = rsDefects!PartName
Def1.Text = rsDefects!Defect1
Def2.Text = rsDefects!Defect2
Def3.Text = rsDefects!Defect3
Def4.Text = rsDefects!Defect4
Def5.Text = rsDefects!Defect5

rsMachine.Close
rsParts.Close
rsDefects.Close
conData.Close
End Sub

Private Sub LoadMachine()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

cmbMachine.Clear

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT MachineName FROM Machines ORDER BY MachineName", conData, adOpenStatic, adLockOptimistic

If rsData.BOF = True Or rsData.EOF = True Then
    'add code here
        Else
    Do While rsData.EOF = False
        cmbMachine.AddItem rsData!MachineName
        rsData.MoveNext
    Loop
End If

rsData.Close
conData.Close
End Sub

Private Sub LoadParts()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Dim strData As String

strData = cmbMachine.Text

cmbMachine.Clear

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT MachineName, PartName FROM Parts WHERE MachineName =" & "'" & strData & "'", conData, adOpenStatic, adLockOptimistic

If rsData.BOF = True Or rsData.EOF = True Then
    'add code here
        Else
    Do While rsData.EOF = False
        cmbParts.AddItem rsData!PartName
        rsData.MoveNext
    Loop
End If

rsData.Close
conData.Close
End Sub

Private Sub LoadListbox()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Dim strData As String

strData = cmbParts.Text

cmbParts.Clear

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT * FROM PartDefects WHERE PartName =" & "'" & strData & "'", conData, adOpenStatic, adLockOptimistic

If rsData.BOF = True Or rsData.EOF = True Then
    'add code here
        Else
    Do While rsData.EOF = False
        List1.AddItem rsData!PartName & ", Defects = " _
        & rsData!Defect1 & ", " _
        & rsData!Defect2 & ", " _
        & rsData!Defect3 & ", " _
        & rsData!Defect4 & ", " _
        & rsData!Defect5 & "--->>>"
        rsData.MoveNext
    Loop
End If

rsData.Close
conData.Close
End Sub

Private Sub SaveMachineData()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT MachineNumber, MachineName FROM Machines ORDER BY MachineName", conData, adOpenStatic, adLockOptimistic

rsData.AddNew

rsData!MachineNumber = txtMachineNumber.Text
rsData!MachineName = txtMachineName.Text

rsData.Update

rsData.Close
conData.Close
End Sub

Private Sub EditMachineData()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT MachineNumber, MachineName FROM Machines ORDER BY MachineName", conData, adOpenStatic, adLockOptimistic

rsData!MachineNumber = txtMachineNumber.Text
rsData!MachineName = txtMachineName.Text

rsData.Update

rsData.Close
conData.Close
End Sub

Private Sub SavePartsData()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT PartNumber, PartName, MachineName FROM Parts ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsData.AddNew

rsData!PartNumber = txtPartNumber.Text
rsData!PartName = txtPartName.Text
rsData!MachineName = txtMachineParts.Text

rsData.Update

rsData.Close
conData.Close
End Sub

Private Sub EditPartsData()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT PartNumber, PartName, MachineName FROM Parts ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsData!PartNumber = txtPartNumber.Text
rsData!PartName = txtPartName.Text
rsData!MachineName = txtMachineParts.Text

rsData.Update

rsData.Close
conData.Close
End Sub

Private Sub SaveDefectsData()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT * FROM PartDefects ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsData.AddNew

rsData!PartNumber = txtPartNum.Text
rsData!PartName = txtPartNames.Text
rsData!Defect1 = Def1.Text
rsData!Defect2 = Def2.Text
rsData!Defect3 = Def3.Text '
rsData!Defect4 = Def4.Text
rsData!Defect5 = Def5.Text

rsData.Update

rsData.Close
conData.Close
End Sub

Private Sub EditDefectsData()

Dim conData As ADODB.Connection
Dim rsData As ADODB.Recordset

Set conData = New ADODB.Connection

conData.Open "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & App.Path & "\RéparationDeMachinesDansLa.mdb"

conData.CursorLocation = adUseClient

Set rsData = New ADODB.Recordset
    
rsData.Open "SELECT * FROM PartDefects ORDER BY PartName", conData, adOpenStatic, adLockOptimistic

rsData!PartNumber = txtPartNum.Text
rsData!PartName = txtPartNames.Text
rsData!Defect1 = Def1.Text
rsData!Defect2 = Def2.Text
rsData!Defect3 = Def3.Text '
rsData!Defect4 = Def4.Text
rsData!Defect5 = Def5.Text

rsData.Update

rsData.Close
conData.Close
End Sub

Private Sub cmbMachine_Click()

Call LoadParts

cmbParts.Visible = True
End Sub

Private Sub cmbParts_Click()

Call LoadListbox
End Sub

Private Sub Command1_Click()

fraAddNew.Visible = True
End Sub

Private Sub Command10_Click()

Call SavePartsData
Call ClearTextboxes(Me)
fraParts.Visible = False
End Sub

Private Sub Command11_Click()

Call SaveDefectsData
Call ClearTextboxes(Me)
fraDefects.Visible = False
End Sub

Private Sub Command13_Click()

fraParts.Visible = True
fraEdit.Visible = False
End Sub

Private Sub Command14_Click()

fraMachine.Visible = True
fraEdit.Visible = False
End Sub

Private Sub Command15_Click()

Call MoveNextData
End Sub

Private Sub Command16_Click()

Call MoveNextData
End Sub

Private Sub Command17_Click()

Call MoveNextData
End Sub

Private Sub Command18_Click()

Unload Me

frmView.Show 1
End Sub

Private Sub Command19_Click()

Dim Form As Form
   For Each Form In Forms
      Unload Form
    Set Form = Nothing
Next Form
End Sub

Private Sub Command2_Click()

fraMachine.Visible = True
fraAddNew.Visible = False
End Sub

Private Sub Command20_Click()

'First select a machine from cmbMachines
cmbMachine.Visible = True
Call LoadMachine
End Sub

Private Sub Command3_Click()

fraParts.Visible = True
fraAddNew.Visible = False
End Sub

Private Sub Command4_Click()

fraDefects.Visible = True
fraAddNew.Visible = False
End Sub

Private Sub Command5_Click()

Call SaveMachineData
Call ClearTextboxes(Me)
fraMachine.Visible = False
End Sub

Private Sub Command7_Click()

fraEdit.Visible = True
Call LoadData
End Sub

Private Sub Command8_Click()

fraDefects.Visible = True
fraEdit.Visible = False
End Sub