Multi Select List Box

D

dewanchoudhury

I am kind of novice to VBA utilization. I wonder if
someone from this group can help me, I will appreciate
for your patience.

I have a master table called 'tblProjects' - it has 2
fields - 'ProjectBUScopeID' & 'ProjectBUScopeName'.
These two fields data needed to be stored from a
form 'frmProjects' where I have a multi select listbox
that is created from a query out of a table 'tblBUScope'
that has 15 items listed.

I need to assign or select via a command button 1 or
more selected items from a different tbale 'tblBUScope'
that has to fields 'BUScopeID' and 'BUScopeName'
to 'ProjectBUScopeID' & 'ProjectBUScopeName' that applies
to the each individual project and stores them to the
individual table; also I need to show the assigned or
selected items on a different window on the
form 'frmProjects.

What I did so for is I created a list box using a query
from the 'tblBUScope' and I am able to select multiple
choices but when I click on the command button next to
it, it gives me an error. I created a click event on the
button to update/store the selected item calling a
function but I don't think I did everything quite right.

The following codes that I tried which is not working -
anotherwords I got the error - '3265 item not found in
this collection.

Private Sub Command553_Click()

On Error GoTo Err_Command553_Click

Me.TextNotice = CreateProjectBURecords
(Me.ProjectBUScope) & " Records Created"
Me.ProjectBUScope.Requery

Exit_Command553_Click:
Exit Sub

Err_Command553_Click:
MsgBox Err.Number & "-" & Err.Description
Resume Exit_Command553_Click

End Sub
----

Public Function CreateProjectBURecords(ctlRef As ListBox)
Dim i As Variant
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qd As DAO.QueryDef
Dim RecCount As Integer

Set dbs = CurrentDb
Set qd = dbs.QueryDefs!qBUScopeAppend
Set rst = qd.OpenRecordset
RecCount = 0
For Each i In ctlRef.ItemsSelected
rst.AddNew
rst!BUScopeID = ctlRef.ItemData(i)
rst!BUScopeName = Me.ProjectBUScopeName
rst.Update
RecCount = RecCount + 1
Next i
Set rst = Nothing
Set qd = Nothing
CreateProjectBURecords = RecCount

Exit_CreateProjectBURecords:
Exit Function

Err_CreateProjectBURecords:
Select Case Err.Number
Case 3022 'ignore duplicate keys
RecCount = RecCount - 1
Resume Next
Case Else
MsgBox Err.Number & "-" & Err.Description
Resume Exit_CreateProjectBURecords
End Select

End Function



-------


again,


My two tables 'tblProjects' (Master table)

ProjectID
ProjectName
ProjectDescription
ProjectBUScopeID**
ProjectBUScopeName ***
ProjectManager
ProjectStatus
Comments

Which is getting the data from the 2nd table

'tblBUScope' (small table) - where I have only

BUScopeID **- 14ID - Primary Key -
1,2,3,4,5,6,7,8,9,10,11,12,13,14
BUScopeName ***- 14 Corresponding Names - ALL, COMPANY,
COMPANY IT, EFR, EFN, FID, EFS, FIR, MAB, NNA, SAP, UAS,
XAB, ZAP

I created a list box using the wizard clicking on the
list box. On the wizard out of the 3 choices when it
asked I checked 'I want the list box to look up the
values in a table or query (ie. 1st choice), and
selected 'tblBUScope's both the fileds and on the last
step when it asked where to store the value I
picked 'ProjectBUScopeID' which is 'Projects' table.
I changed the listbox to Extended for multi select.

I created a command button and on the button's I pasted
your code on on click event.

I didn't get any compiling error but it is not storing
the data to the table.


----- someone suggested below --- didn't help much



make sure the make of the list box you are multi-
selecting from is not the same name as the field you are
selecting.
..... lstProjectBUScope

You never told the code o use the error handler so I
removed it ... you can find exactly what line you are
getting an error on by clicking Debug when the error
message pops up. PLease let us know which line it is.

Public Function CreateProjectBURecords() As Integer
Dim varItem As Variant
Dim rst As DAO.Recordset
Dim intCount As Integer

Set rst = CurrentDB.OpenRecordset("tblProjects",
dbOpenDynaset, dbAppendOnly)
For Each varItem In Me.lstProjectBUScope.ItemsSelected
rst.AddNew
rst.Fields("BUScopeID").Value =
Me.lstProjectBUScope.ItemData(varItem)
rst.Fields("BUScopeName").Value =
Me.ProjectBUScopeName.Value
rst.Update
intCount = intCount + 1
Next varItem

rst.Close
Set rst = Nothing

CreateProjectBURecords = intCount

End Function


-------



Thanks,
Dewan Choudhury
212 762 1043
 

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