Hi all, greate site and i have been able to solve most problems by using the search box although this problem is doing my head in...!!
I have a db that records project numbers and their details. I am using a listbox to allow a user to multiselect Project Involvements Tasks(ie Documentation, Build etc) against a project number.
I am able to read the selections into a separtate table with two columns which is structured as:
ProjectNo - InvolvementType
123 - Testing
123 - Build
123 - Documentation
456 - Build
789 - Testing
789 - Documentation
as you can see I dont have a problem getting the Itemsselected into a table... the problem that i am having is getting them out again when the record is displayed - ie marking them as itemsselected.
I believe that the event would be onCurrent which would loop through this table pick up the project number and recorded invovements and mark them as selected in the listbox. if there is no invovement then the listbox would show no selections.
I am using this code to read the selections in
===========================
'Records project involvements against project
Public Function AddInvolvements(ctlRef As ListBox) As String
On Error GoTo Err_AddInvolvements_Click
Dim i As Variant
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim qd As DAO.QueryDef
Dim strDelete As String
Set dbs = CurrentDb
Set qd = dbs.QueryDefs!qInvolvement
Set rs = qd.OpenRecordset
'Delete records where project number exists against an invovelment incase of involvement changes
strDelete = "Delete Project_Involvement.ProjectNo " & _
"FROM Project_Involvement " & _
"WHERE (((Project_Involvement.ProjectNo)=[Forms]![Add_Project_Details]![ProjectNo]));"
DoCmd.SetWarnings False
DoCmd.RunSQL strDelete
DoCmd.SetWarnings True
For Each i In ctlRef.ItemsSelected
rs.AddNew
rs!InvolvementType = ctlRef.ItemData(i)
rs!ProjectNo = Me.ProjectNo.Value
rs.Update
Next i
Set rs = Nothing
Set qd = Nothing
Exit_AddInvolvements_Click:
Exit Function
Err_AddInvolvements_Click:
Select Case Err.Number
Case 3022 'ignore duplicate keys
Resume Next
Case Else
MsgBox Err.Number & "-" & Err.Description
Resume Exit_AddInvolvements_Click
End Select
End Function
===================================
Any help would be much appreciated - also thanks to Pat Hartman for his excellent examples esp http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=54924
Regards
Robert
I have a db that records project numbers and their details. I am using a listbox to allow a user to multiselect Project Involvements Tasks(ie Documentation, Build etc) against a project number.
I am able to read the selections into a separtate table with two columns which is structured as:
ProjectNo - InvolvementType
123 - Testing
123 - Build
123 - Documentation
456 - Build
789 - Testing
789 - Documentation
as you can see I dont have a problem getting the Itemsselected into a table... the problem that i am having is getting them out again when the record is displayed - ie marking them as itemsselected.
I believe that the event would be onCurrent which would loop through this table pick up the project number and recorded invovements and mark them as selected in the listbox. if there is no invovement then the listbox would show no selections.
I am using this code to read the selections in
===========================
'Records project involvements against project
Public Function AddInvolvements(ctlRef As ListBox) As String
On Error GoTo Err_AddInvolvements_Click
Dim i As Variant
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim qd As DAO.QueryDef
Dim strDelete As String
Set dbs = CurrentDb
Set qd = dbs.QueryDefs!qInvolvement
Set rs = qd.OpenRecordset
'Delete records where project number exists against an invovelment incase of involvement changes
strDelete = "Delete Project_Involvement.ProjectNo " & _
"FROM Project_Involvement " & _
"WHERE (((Project_Involvement.ProjectNo)=[Forms]![Add_Project_Details]![ProjectNo]));"
DoCmd.SetWarnings False
DoCmd.RunSQL strDelete
DoCmd.SetWarnings True
For Each i In ctlRef.ItemsSelected
rs.AddNew
rs!InvolvementType = ctlRef.ItemData(i)
rs!ProjectNo = Me.ProjectNo.Value
rs.Update
Next i
Set rs = Nothing
Set qd = Nothing
Exit_AddInvolvements_Click:
Exit Function
Err_AddInvolvements_Click:
Select Case Err.Number
Case 3022 'ignore duplicate keys
Resume Next
Case Else
MsgBox Err.Number & "-" & Err.Description
Resume Exit_AddInvolvements_Click
End Select
End Function
===================================
Any help would be much appreciated - also thanks to Pat Hartman for his excellent examples esp http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=54924
Regards
Robert
Last edited:
