tbl said:
Is it not feasable (reasonable?) to get a multi-select list
box to accept multiple selections and create multiple
records in a "join" table?
It's perfectly doable; it's just that you have to do all the work
yourself, as Access doesn't natively support a bound multiselect list
box. Here's code from a sample form that represents "family members",
with a list box named "lstHobbies" that represents, for each family
member, that person's hobbies from the list of all possible hobbies.
'----- start of code -----
Option Compare Database
Option Explicit
Private Sub ClearHobbySelections()
Dim intI As Integer
With Me.lstHobbies
For intI = (.ItemsSelected.Count - 1) To 0 Step -1
.Selected(.ItemsSelected(intI)) = False
Next intI
End With
End Sub
Private Sub Form_Current()
Dim rs As DAO.Recordset
Dim intI As Integer
' Clear all currently selected hobbies.
ClearHobbySelections
If Not Me.NewRecord Then
Set rs = CurrentDb.OpenRecordset( _
"SELECT HobbyID FROM tblFamilyMembersHobbies " & _
"WHERE MemberID=" & Me.MemberID)
' Select the hobbies currently on record for this MemberID.
With Me.lstHobbies
Do Until rs.EOF
For intI = 0 To (.ListCount - 1)
If .ItemData(intI) = CStr(rs!HobbyID) Then
.Selected(intI) = True
Exit For
End If
Next intI
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End With
End If
End Sub
Private Sub lstHobbies_AfterUpdate()
On Error GoTo Err_lstHobbies_AfterUpdate
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim strSQL As String
Dim blnInTransaction As Boolean
Dim varItem As Variant
' Make sure the current member record has been saved.
If Me.Dirty Then Me.Dirty = False
Set ws = Workspaces(0)
Set db = ws.Databases(0)
ws.BeginTrans
blnInTransaction = True
' Delete all hobbies now on record.
strSQL = "DELETE FROM tblFamilyMembersHobbies " & _
"WHERE Memberid = " & Me.MemberID
db.Execute strSQL, dbFailOnError
' Add each hobby selected in the list box.
With Me.lstHobbies
For Each varItem In .ItemsSelected
strSQL = _
"INSERT INTO tblFamilyMembersHobbies " & _
"(MemberID, HobbyID) VALUES (" & _
Me.MemberID & ", " & .ItemData(varItem) & ")"
db.Execute strSQL, dbFailOnError
Next varItem
End With
ws.CommitTrans
blnInTransaction = False
Exit_lstHobbies_AfterUpdate:
Set db = Nothing
Set ws = Nothing
Exit Sub
Err_lstHobbies_AfterUpdate:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbExclamation, "Unable to Update"
If blnInTransaction Then
ws.Rollback
blnInTransaction = False
End If
Resume Exit_lstHobbies_AfterUpdate
End Sub
Private Sub lstHobbies_BeforeUpdate(Cancel As Integer)
Dim intI As Integer
' Don't allow hobbies to be updated before a MemberID has
' been generated.
If IsNull(Me.MemberID) Then
MsgBox "Please enter other information for this family " & _
"member before choosing hobbies.", , _
"Define Member First"
Cancel = True
Me.lstHobbies.Undo
' Clear the user's selection.
ClearHobbySelections
End If
End Sub
'----- end of code -----
As you see, there's a fair amount of code involved, because we're using
the list box to do something it wasn't built to do, but it works quite
nicely.
