Help writing multi select list box selections to table

[mystif]

I am a novice who has built a database to track vineyard spray records. I
have put a multi-select list box on a data entry form, and cannot figure out
how to get the selections made in that list box to GO somewhere. I need them
to populate to a table. Have read many posts on how to do this and cannot
find an example of code that I can work with at my novice knowlege level.
Any guru's out there want to help a noob out?

Thank you in advance!

 

[John W. Vinson]

I am a novice who has built a database to track vineyard spray records. I
have put a multi-select list box on a data entry form, and cannot figure out
how to get the selections made in that list box to GO somewhere. I need them
to populate to a table. Have read many posts on how to do this and cannot
find an example of code that I can work with at my novice knowlege level.
Any guru's out there want to help a noob out?

Thank you in advance!

This may be the sample code you were referring to. You will need to
change the control names, table names, and field names to match your
database; I can't help much there, because I cannot see your database.

If you try to implement this and have problems, please feel free to
post back with an indication of what specific problems you're having.

Private Sub cmdProcess_Click()
' Comments : Update the AnimalCondition table based on
' the selections in
' the unbound multiselect listbox lstHealthIssues.
' Newly selected rows will be added to the table,
' newly cleared
' rows will be deleted.
' Parameters: None
' Modified : 01/29/02 by JWV
'
' --------------------------------------------------
' Populate the AnimalCondition table with the selected issues
On Error GoTo PROC_ERR

Dim iItem As Integer
Dim lngCondition As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset

' save the current record if it's not saved
If Me.Dirty = True Then
Me.Dirty = False
End If
Set db = CurrentDb
' Open a Recordset based on the table
Set rs = db.OpenRecordset("AnimalCondition", dbOpenDynaset)
With Me!lstHealthIssues
' Loop through all rows in the Listbox
For iItem = 0 To .ListCount - 1
lngCondition = .Column(0, iItem)
' Determine whether this AnimalID-HealthID
' combination is currently
' in the table
rs.FindFirst "[AnimalID] = " & Me.AnimalID & " AND " _
& "[HealthIssueID] = " & lngCondition
If rs.NoMatch Then ' this item has not been added
If .Selected(iItem) Then
' add it
rs.AddNew
rs!AnimalID = Me.AnimalID
rs!HealthIssueID = lngCondition
rs.Update
End If ' if it wasn't selected, ignore it
Else
If Not .Selected(iItem) Then
' delete this record if it's been deselected
rs.Delete
End If ' if it was selected, leave it alone
End If
Next iItem
End With
rs.Close
Set rs = Nothing
Set db = Nothing
Me.subAnimalCondition.Requery

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox "Error " & Err.Number & " in cmdProcess_Click:" _
& vbCrLf & Err.Description
Resume PROC_EXIT

End Sub



John W. Vinson [MVP]

 

[mystif via AccessMonster.com]

If you try to implement this and have problems, please feel free to
post back with an indication of what specific problems you're having.

John,

Thank you so much for the sample code that you provided me. I did paste it
into my VB editor on the form I am using to enter data, and changed (what I
hope is) what I need to; names of the tables, fields & functions. I have
pasted the revised code below. When I tied this code to a macro to run, i
get the error: NO CURRENT RECORD. I have not found any info in Access help
to assist with troubleshooting. Can you see any obvious misteakes I have
made?

Thank you again!

Private Sub cmdProcess_Click()

' Comments : Update the tblOrderNumbBlocksSelected table based on
' the selections in
' the unbound multiselect listbox lstbxVineyardBlockSelect.
' Newly selected rows will be added to the table,
' newly cleared
' rows will be deleted.
' Parameters: None
' Modified : 01/29/02 by JWV
'
' --------------------------------------------------
' Populate the tblOrderNumbBlocksSelected table with the selected issues
On Error GoTo PROC_ERR

Dim iItem As Integer
Dim lngCondition As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset

' save the current record if it's not saved
If Me.Dirty = True Then
Me.Dirty = False
End If
Set db = CurrentDb
' Open a Recordset based on the table
Set rs = db.OpenRecordset("tblOrderNumbBlocksSelected", dbOpenDynaset)
With Me!lstbxVineyardBlockSelect
' Loop through all rows in the Listbox
For iItem = 0 To .ListCount - 1
lngCondition = .Column(0, iItem)
' Determine whether this SprayOrderNumber-Block
' combination is currently
' in the table
rs.FindFirst "[SprayOrderNumber] = " & Me.SprayOrderNumber & " AND
" _
& "[Block] = " & lngCondition
If rs.NoMatch Then ' this item has not been added
If .Selected(iItem) Then
' add it
rs.AddNew
rs!SprayOrderNumber = Me.SprayOrderNumber
rs!OrderBlockID = lngCondition
rs.Update
End If ' if it wasn't selected, ignore it
Else
If Not .Selected(iItem) Then
' delete this record if it's been deselected
rs.Delete
End If ' if it was selected, leave it alone
End If
Next iItem
End With
rs.Close
Set rs = Nothing
Set db = Nothing
Me.subtblOrderNumbBlocksSelected.Requery

PROC_EXIT:
Exit Sub

 

[John W. Vinson]

Thank you so much for the sample code that you provided me. I did paste it
into my VB editor on the form I am using to enter data, and changed (what I
hope is) what I need to; names of the tables, fields & functions. I have
pasted the revised code below. When I tied this code to a macro to run, i
get the error: NO CURRENT RECORD. I have not found any info in Access help
to assist with troubleshooting. Can you see any obvious misteakes I have
made?

Sorry... I didn't get back to you, and now I'm just out of time prior to going
off on a week-long trip. Please repost and hopefully someone else can help.

John W. Vinson [MVP]

 

[mystif via AccessMonster.com]

John,

Thanks for the reply - have a great vacation!

Thank you so much for the sample code that you provided me. I did paste it
into my VB editor on the form I am using to enter data, and changed (what I

[quoted text clipped - 3 lines]

to assist with troubleshooting. Can you see any obvious misteakes I have
made?

Sorry... I didn't get back to you, and now I'm just out of time prior to going
off on a week-long trip. Please repost and hopefully someone else can help.

John W. Vinson [MVP]