Multiselect listbox to add records to a table (1 Viewer)

Tep · Dec 15, 2010

Hi,

I have a form with an multiselect listbox (ListKAPprodukten), a textbox (TBvor_id) and a Command button.
On click of the command button, I want to add the selected items of the listbox and the value of the textbox to a table (dbo_residunorm_nieuw), that is shown in a subform.
I found on baldyweb (sorry, I am not allowed to post links) a code that should work. This is my version of that code:
-------------------------------------
Private Sub BTtoevoegen_Click()
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ctl As Control
Dim varItem As Variant
On Error GoTo ErrorHandler
Set db = CurrentDb()
Set rs = db.OpenRecordset("dbo_residunorm_nieuw", dbOpenDynaset, dbAppendOnly)
'make sure a selection has been made
If Me.ListKAPprodukten.ItemsSelected.Count = 0 Then
MsgBox "Selecteer tenminste 1 KAP-produkt"
Exit Sub
End If

Set ctl = Me.ListKAPprodukten
For Each varItem In ctl.ItemsSelected
rs.AddNew
rs!pro_id = ctl.ItemData(ctl.ItemsSelected(0))
rs!vor_id = Me.TBvor_id
rs.Update
Next varItem
ExitHandler:
Set rs = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err
Case Else
MsgBox Err.Description
DoCmd.Hourglass False
Resume ExitHandler
End Select
End Sub
--------------------
This does work for the value in the textbox and it does add the amount of records that is selected in the listbox, but pro_id remains null. No error message is shown.

Why does it not add the values of the selected items in the listbox to the table?

Some additional information
The listbox (ListKAPprodukten) is filled with this code:
-------------------------------------------
Private Sub CBpsu_nr_AfterUpdate()
Dim sSql As String
sSql = "SELECT * FROM EU_KAP_met_KAP_produktenboom WHERE EU_KAP_met_KAP_produktenboom.EU_psu_nr = " & CBpsu_nr.Column(2) & " ;"
ListKAPprodukten.RowSource = sSql
ListKAPprodukten.Requery
End Sub
------------------------------------------
In the query "EU_KAP_met_KAP_produktenboom" the first field is pro_id, which is a autonumber in a linked table.

I hope someone can help me with this!
Thanks in advance,
Tep

Mr. B · Dec 15, 2010

Try changing the line:
rs!pro_id = ctl.ItemData(ctl.ItemsSelected(0))

to:
rs!pro_id = ctl.ItemData(varItem)

That will read the value of each of the selected Items in the listbox.

Tep · Dec 15, 2010

Thanks for your suggestion. The problem, however, does still exists when I change that line

The value from the listbox is not added...

In your suggestion I miss an link to the column in the listbox. Thats why I
had typed:
rs!pro_id = ctl.ItemData(ctl.ItemsSelected(0))
But you are right that it should probably be:
rs!pro_id = ctl.ItemData(varItem)

But, what's wrong then...???

Mr. B · Dec 15, 2010

First,
I would suggest that you comment out all of your error handling code and then run it. This should causer an error message to be presented. With that you may be able to find where the problem is.

Then, I would try defining a temporary variable that you can assign the value from the selected Item in the listbox. Do this just prior to the "rs.addnew" line. Put a break point on the line and run your code. This way you can stop and step through your code and observe the value that is being returned to the temporary variable. If you are not getting the value from each of the selected items then that will at least tell you where you problem is.

Try this a post back. Someone should be able to continue to try to help.

Tep · Dec 16, 2010

Thanks. These are good ideas. Unfortunately I am not able to try this at the moment(got sick and can not access database at home), so the outcome of your suggestions will come later.

Tep · Jan 17, 2011

Hi,
As suggested by Mr. B, I disabled all the error handling codes, put a temporary variable, assigned the values from the multiple select listbox to it, put a breakpoint to the line and run the code.
Now I got the error message: "Run-time error 3265 Item not found in this collection" on the bold line:

Private Sub BTtoevoegen_Click()
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ctl As Control
Dim varItem As Variant
'On Error GoTo ErrorHandler
Set db = CurrentDb()
Set rs = db.OpenRecordset("dbo_residunorm_nieuw", dbOpenDynaset, dbAppendOnly)
'make sure a selection has been made
If Me.ListKAPprodukten.ItemsSelected.Count = 0 Then
MsgBox "Selecteer tenminste 1 KAP-produkt"
Exit Sub
End If
Set ctl = Me.ListKAPprodukten
For Each varItem In ctl.ItemsSelected
rs!Temp = ctl.ItemData(varItem)
rs.AddNew
rs!pro_id = ctl.ItemData(varItem)
rs!vor_id = Me.TBvor_id
rs.Update
Next varItem
ExitHandler:
Set rs = Nothing
Set db = Nothing
Exit Sub
'ErrorHandler:
'Select Case Err
'Case Else
'MsgBox Err.Description
'DoCmd.Hourglass False
'Resume ExitHandler
'End Select
End Sub

Any idea what I should do to fix this?

Maybe of importance: the listbox "ListKAPprodukten" has a bound column 0 and is filled by the following statement:

Private Sub CBpsu_nr_AfterUpdate()
Dim sSql As String
sSql = "SELECT pro_id FROM EU_KAP_met_KAP_produktenboom WHERE EU_KAP_met_KAP_produktenboom.EU_psu_nr = " & CBpsu_nr.Column(2) & " ;"
ListKAPprodukten.RowSource = sSql
ListKAPprodukten.Requery
End Sub

I hop someone can help me!!!
Thanks.

CBrighton · Jan 17, 2011

You cannot add something to rs!temp as you have not yet created a record within rs at that point.

If you are using a temp variable do something like:

Dim strTemp as string (at the top with your other declarations)
strTemp = ctl.ItemData(varItem)

However this should not be needed, it should work fine without a temp variable.

For example, here is a piece of code for cancelling holidays from one of my databases which works off a listbox of booked dates:

Code:

Dim DB As Database
Set DB = CurrentDb
Dim oItem As Variant
Screen.MousePointer = 11
For Each oItem In Me!lstDates.ItemsSelected
    DB.Execute "INSERT INTO tblCancelledHolidays ( Name, HoursBooked, DateBooked, TotalHours, CancelledBy, TeamAvail, AgentAvail, LoadedBy, Loaded ) " & _
               "SELECT tblHolidays.Name, tblHolidays.HoursBooked, tblHolidays.DateBooked, tblHolidays.TotalHours, '" & GetName() & "', TeamAvail, AgentAvail, LoadedBy, Loaded " & _
               "FROM tblHolidays " & _
               "WHERE tblHolidays.Ref = " & lstDates.ItemData(oItem)
 
    DB.Execute "DELETE * FROM tblHolidays WHERE tblHolidays.Ref = " & lstDates.ItemData(oItem)
Next oItem
Screen.MousePointer = 0
MsgBox "Holiday cancelled"

smig · Jan 17, 2011

few comments before we go to the specific code:
1. put your code in acode box. it will be easier to read
2. Set rs = ... after you check you 'make sure a selection has been made

your code should look like:

Code:

Set db = CurrentDb()
Set rs = db.OpenRecordset("dbo_residunorm_nieuw", dbOpenDynaset, dbAppendOnly)

For Each varItem In Me.ListKAPprodukten.ItemsSelected
  rs.AddNew
  rs!pro_id = Me.ListKAPprodukten.Column(0, varItem)
  rs!vor_id = Me.TBvor_id
  rs.Update
Next varItem

Set rs = Nothing
Set db = Nothing

Tep · Jan 17, 2011

YES! it works!

Thanks very very much for all your suggestions.

Code:

Private Sub BTtoevoegen_Click()
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ctl As Control
Dim varItem As Variant
On Error GoTo ErrorHandler
Set db = CurrentDb()
If Me.ListKAPprodukten.ItemsSelected.Count = 0 Then
MsgBox "Selecteer tenminste 1 KAP-produkt"
Exit Sub
End If
Set rs = db.OpenRecordset("dbo_residunorm_nieuw", dbOpenDynaset, dbAppendOnly)
For Each varItem In Me.ListKAPprodukten.ItemsSelected
rs.AddNew
rs!pro_id = Me.ListKAPprodukten.Column(0, varItem)
rs!vor_id = Me.TBvor_id
rs.Update
Next varItem
[SF dbo_residunorm_nieuw].Requery
ExitHandler:
Set rs = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err
Case Else
MsgBox Err.Description
DoCmd.Hourglass False
Resume ExitHandler
End Select
End Sub

smig · Jan 17, 2011

glad we could help

ytros · Jun 9, 2011

HI ,
I got a problem with listbox and table. My table name is "Tcom" in this table, it has 10 fields name "Article0"...to "article10", 10 fields of quantity named "q1"..to "q10", 1fields for the total
on the form there is 5 listbox named "l1" to "l5", each of them related to 1 input box for entering the number of quantity("q1"..to "q5") and 5 button "OK" (named "bok1" to "bok5") and 1 input box for display the total of each button...
In the listbox "l1" to "l5" I use a querry to display data, bound column is 2 because I'd like to display a list with( item(type Text), price(number, single)...

My problem is when I add the items from listbox to table "Tcom"..It always transfer the number(of the price) into a field "Article0"...to "Article10" in table "Tcom".
I've tried to change the bound value to 1, 0 ..it didn't work. Do you have any idea about it? Please help. Many thanks.
Ytros

bmaccess · Mar 24, 2016

Thank you very much for the person who posted this code. This code works very nice. I used the code and just changed my table names and key names.
Thanks
BMAccess

Code:

Private Sub BTtoevoegen_Click()
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ctl As Control
Dim varItem As Variant
On Error GoTo ErrorHandler
Set db = CurrentDb()
If Me.ListKAPprodukten.ItemsSelected.Count = 0 Then
MsgBox "Selecteer tenminste 1 KAP-produkt"
Exit Sub
End If
Set rs = db.OpenRecordset("dbo_residunorm_nieuw", dbOpenDynaset, dbAppendOnly)
For Each varItem In Me.ListKAPprodukten.ItemsSelected
rs.AddNew
rs!pro_id = Me.ListKAPprodukten.Column(0, varItem)
rs!vor_id = Me.TBvor_id
rs.Update
Next varItem
[SF dbo_residunorm_nieuw].Requery
ExitHandler:
Set rs = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err
Case Else
MsgBox Err.Description
DoCmd.Hourglass False
Resume ExitHandler
End Select
End Sub

[/QUOTE]

Multiselect listbox to add records to a table (1 Viewer)

Tep

Registered User.

Mr. B

"Doctor Access"

Tep

Registered User.

Mr. B

"Doctor Access"

Tep

Registered User.

Tep

Registered User.

CBrighton

Surfing while working...

smig

Registered User.

Tep

Registered User.

smig

Registered User.

ytros

New member

bmaccess

Member

Similar threads

Users who are viewing this thread