I started with the code written by someone else.
It is located at: http://www.datagnostics.com/dtips/multiselect.html
I changed it slightly to save the selections from a list box and also allow the user to add information in an input box for each selection made.
All seems to work well, if I make one selection from the list box it is fine, however
when I make multiple selections, I get TOO MANY input boxes.
For example:
If I make my first selection, I enter into the input box, all is ok;
I Make the second selection and enter into that input box and it seems all is ok,
BUT then I get a 3rd input box, which is not okay.
The insert statement inserts what is entered into the 1st input box,
then writes over it with what is entered into the 2nd input box and
the 3rd input box is inserted ok. (Unless of course you make more selections)
It seems that I am so close, but I can't seem see how to fix my problem.
Here is the code:
It is located at: http://www.datagnostics.com/dtips/multiselect.html
I changed it slightly to save the selections from a list box and also allow the user to add information in an input box for each selection made.
All seems to work well, if I make one selection from the list box it is fine, however
when I make multiple selections, I get TOO MANY input boxes.
For example:
If I make my first selection, I enter into the input box, all is ok;
I Make the second selection and enter into that input box and it seems all is ok,
BUT then I get a 3rd input box, which is not okay.
The insert statement inserts what is entered into the 1st input box,
then writes over it with what is entered into the 2nd input box and
the 3rd input box is inserted ok. (Unless of course you make more selections)
It seems that I am so close, but I can't seem see how to fix my problem.
Here is the code:
Code:
Option Compare Database
Option Explicit
Private Sub ClearStorageSelections()
Dim intI As Integer
With Me.lstStorageUnit
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 storage units.
ClearStorageSelections
If Not Me.NewRecord Then
Set rs = CurrentDb.OpenRecordset( _
"SELECT INC_ID FROM INC_STORAGE " & _
"WHERE INC_ID=" & Me.INC_ID)
' Select the storage units currently on record for this MemberID.
With Me.lstStorageUnit
Do Until rs.EOF
For intI = 0 To (.ListCount - 1)
If .ItemData(intI) = CStr(rs!STORAGE_ID) 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 lstStorageUnit_AfterUpdate()
On Error GoTo Err_lstStorageUnit_AfterUpdate
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim strSQL As String
Dim blnInTransaction As Boolean
Dim varItem As Variant
Dim unitNum As Variant
Dim thermoId As Variant
'unitNum = 0
' Make sure the current incident record has been saved.
If Me.Dirty Then Me.Dirty = False
Set ws = DBEngine(0)
Set db = CurrentDb
ws.BeginTrans
blnInTransaction = True
' Delete all storage units now on record.
strSQL = "DELETE FROM INC_STORAGE " & _
"WHERE INC_ID = " & Me.INC_ID
db.Execute strSQL, dbFailOnError
' Add each storage unit selected in the list box.
With Me.lstStorageUnit
For Each varItem In .ItemsSelected
'User Input for unit Num, which will be the Storage Unit Number.
unitNum = InputBox("ENTER THE NUMBER OF STORAGE UNITS OF THIS TYPE", "UNIT NUMBER", 0)
strSQL = _
"INSERT INTO INC_STORAGE " & _
"(INC_ID, STORAGE_ID, STORAGE_UNIT_NUMBER) VALUES (" & _
Me.INC_ID & ", " & .ItemData(varItem) & ", " & unitNum & ")"
Debug.Print "INC_ID is " & Me.INC_ID
Debug.Print "item from listbox is " & .ItemData(varItem)
Debug.Print "unit num is " & unitNum
db.Execute strSQL, dbFailOnError
Next varItem
End With
ws.CommitTrans
blnInTransaction = False
Exit_lstStorageUnit_AfterUpdate:
Set db = Nothing
Set ws = Nothing
Exit Sub
Err_lstStorageUnit_AfterUpdate:
MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION, _
vbExclamation, "Unable to Update"
If blnInTransaction Then
ws.Rollback
blnInTransaction = False
End If
Resume Exit_lstStorageUnit_AfterUpdate
End Sub
Private Sub lstStorageUnit_BeforeUpdate(Cancel As Integer)
Dim intI As Integer
' Don't allow hobbies to be updated before a Incident ID has
' been generated.
If IsNull(Me.INC_ID) Then
MsgBox "Please enter other information for this incident " & _
"before choosing a storage unit.", , _
"Define Incident First"
Cancel = True
Me.lstStorageUnit.Undo
' Clear the user's selection.
ClearStorageSelections
End If
End Sub
