I have a subform (sfrmAnswers) that I have a list box (List6) on. I have the
Multi-Select Property set to Simple.
I need to be able to save the data selected in a single record in the
corresponding table (tblAnswers) field (Response).
I know that it takes VB code to accomplish this, but have been unsuccessful
to this point.
Also, if the record is re-reviewed, I need it to re-display the data that
was saved. Any suggestions?
I know that this does not comply with the Fundamentals of Relational
Database Design. Is there any way that this can be accomplished, even if it
is not with a list?
It's actually perfectly in accord with the fundamentals, IMO - just
using a particular tool for the job.
You'll also wont to put code (derived from this) in the Form's Current
event to repopulate the listbox. Mind the linewrap and (of course)
adapt the table/fieldnames.
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]
