Multi-Select List Box (?)


T

tbl

Is it not feasable (reasonable?) to get a multi-select list
box to accept multiple selections and create multiple
records in a "join" table?
 
Ad

Advertisements

D

Dirk Goldgar

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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top