Multi Select ListBox

[Aric Green]

I have a form in my database that contains a listbox of card numbers. This
listbox is a multiselect listbox. I also have a combobox with employee
names. I want to choose an employee name and then select multiple card
numbers and when i click a button I want the cards to be assigned to the
employee in the table. The table contains a field for the employee name.
The code I have so far is as follows

code
------------------------------------------------------------------------------------------------
Private Sub ASSIGN_USER_TO_CARDS_Click()
Dim db As Database
Dim rec As Recordset
Dim varSelected As Variant
Dim strSQL As String
Set db = CurrentDb()
Set rec = db.OpenRecordset("CARDSTOCK ACCOUNTABILITY")
For Each varSelected In Me!List9.ItemsSelected
strSQL = ""
strSQL = strSQL & " Update CARDSTOCK_ACCOUNTABILITY SET
CLERK_CARD_ISSUED_TO = " & Me.cmb11
strSQL = strSQL & " WHERE CLERK_CARD_ISSUED_TO = " &
Me!List9.ItemData(varSelected)
CurrentDb.Execute strSQL
Next varSelected
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End Sub
------------------------------------------------------------------------------------------------

When I push the button it gives me an error the following error.
Run-time error '3075':
Syntax error (missing operator) in query expression 'USERS NAME IS HERE'.

When I click debug the line
CurrentDB.Execute strSQL
is highlighted.

I have tryed DoCmd.RunSQL strSQL and get the same thing. I am not sure what
I have done wrong. I am fairly new to writing vb code.
Thanks.

 

[Douglas J. Steele]

I'm guessing that CLERK_CARD_ISSUED_TO is a text field, not a numeric one.
If that's the case, you need to put quotes around the name:

strSQL = strSQL & " Update CARDSTOCK_ACCOUNTABILITY "
strSQL = strSQL & " SET CLERK_CARD_ISSUED_TO = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE CLERK_CARD_ISSUED_TO = """ &
Me!List9.ItemData(varSelected) & """"

That's three double quotes in front, and four double quotes after.

You might find the following more efficient. It only has 1 SQL statement to
execute.

Private Sub ASSIGN_USER_TO_CARDS_Click()
Dim db As Database
Dim rec As DAO.Recordset
Dim strWhere As String
Dim varSelected As Variant
Dim strSQL As String

Set db = CurrentDb()
Set rec = db.OpenRecordset("CARDSTOCK ACCOUNTABILITY")
If Me!List9.ItemsSelected.Count > 0 Then
For Each varSelected In Me!List9.ItemsSelected
strWhere = strWhere & """" & Me!List9.ItemData(varSelected) & """, "
Next varSelected
strSQL =
strSQL = strSQL & "UPDATE CARDSTOCK_ACCOUNTABILITY " & _
strSQL = strSQL & "SET CLERK_CARD_ISSUED_TO = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE CLERK_CARD_ISSUED_TO IN (" &
strSQL = strSQL & Left$(strWhere, Len(strWhere) - 2) & ")"
CurrentDb.Execute strSQL
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End Sub

 

[Aric Green]

Douglas,
I gave your second solution a shot and access complained about there
not being an end if. I inserted the end if into the code where I thought it
should go. Not sure if it is right. Here is the code that I am now trying
to use.
=======
Private Sub ASSIGN_USER_TO_CARDS_Click()
Dim db As Database
Dim rec As DAO.Recordset
Dim strWhere As String
Dim varSelected As Variant
Dim strSQL As String

Set db = CurrentDb()
Set rec = db.OpenRecordset("CARDSTOCK ACCOUNTABILITY")
If Me!List9.ItemsSelected.Count > 0 Then
For Each varSelected In Me!List9.ItemsSelected
strWhere = strWhere & """" & Me!List9.ItemData(varSelected)
& """, "
Next varSelected
End If
strSQL = ""
strSQL = strSQL & "UPDATE CARDSTOCK_ACCOUNTABILITY " & _
strSQL = strSQL & "SET CLERK_CARD_ISSUED_TO = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE CLERK_CARD_ISSUED_TO IN (" & _
strSQL = strSQL & Left$(strWhere, Len(strWhere) - 2) & ")"
CurrentDb.Execute strSQL
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End Sub
=======
After that I got a runtime error 3078: The Microsoft Jet database engine
cannot find the input table or query 'False'. Make sure it exists and that
its name is spelled correctly.
I am not sure what is causing this. Is it refering to the employees listed
in the combobox?? If so I wonder if it has to do with how I have that layed
out. The employees are listed in a linked table. I am using a select query
to exclude some of the employees from the list. And finally the row source
for the combobox is set to that query. The form, listbox and combobox are
all unbound and the listbox is also being pulled from a select query. Thanks
in advance for your assistance.

 

[Aric Green]

I think my naming convention has something to do with this not working. When
I used an underscore it was because I had a space in the name.
Example: CARDSTOCK_ACCOUNTABILITY is actually CARDSTOCK ACCOUNTABILITY.
I have gone through and renamed everything that I think I need to and when I
use your first sample I end up getting this error. (Note The X's indicate a
card number)
Run-time error '3075':
Syntax error (missing operator in query expression 'strClerkCardIssuedTo =
"XXXX" Update tblCardstockAccountability SET strClerkCardIssuedTo =
"Employee's Name" WHERE strClerkCardIssuedTo= "XXXX".
Below is the code
=======
Private Sub ASSIGN_USER_TO_CARDS_Click()
Dim db As Database
Dim rec As Recordset
Dim varSelected As Variant
Dim strSQL As String
Set db = CurrentDb()
Set rec = db.OpenRecordset("tblCardstockAccountability")
For Each varSelected In Me!List9.ItemsSelected
strSQL = strSQL & " Update tblCardstockAccountability "
strSQL = strSQL & " SET strClerkCardIssuedTo = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE strClerkCardIssuedTo = """ &
Me!List9.ItemData(varSelected) & """"
CurrentDb.Execute strSQL
Next varSelected
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End Sub
=======
When I use your second sample I get
Run-time error '3078':
The Microsoft Jet database engine cannot find the input table or query
'False'. Make sure it exists and taht its name is spelled correctly.
Example of code
=======
Private Sub ASSIGN_USER_TO_CARDS_Click()
Dim db As Database
Dim rec As DAO.Recordset
Dim strWhere As String
Dim varSelected As Variant
Dim strSQL As String
Set db = CurrentDb()
Set rec = db.OpenRecordset("tblCardstockAccountability")
If Me!List9.ItemsSelected.Count > 0 Then
For Each varSelected In Me!List9.ItemsSelected
strWhere = strWhere & """" & Me!List9.ItemData(varSelected)
& """, "
Next varSelected
End If
strSQL = ""
strSQL = strSQL & "UPDATE tblCardstockAccountability " & _
strSQL = strSQL & "SET strClerkCardIssuedTo = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE strClerkCardIssuedTo IN (" & strSQL = strSQL &
Left$(strWhere, Len(strWhere) - 2) & ")"
CurrentDb.Execute strSQL
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End Sub
=======
Thanks in advance

 

[Douglas J. Steele]

Sorry about that. It should have been

Private Sub ASSIGN_USER_TO_CARDS_Click()
Dim db As Database
Dim rec As DAO.Recordset
Dim strWhere As String
Dim varSelected As Variant
Dim strSQL As String

Set db = CurrentDb()
Set rec = db.OpenRecordset("CARDSTOCK ACCOUNTABILITY")
If Me!List9.ItemsSelected.Count 0 Then
For Each varSelected In Me!List9.ItemsSelected
strWhere = strWhere & """" & Me!List9.ItemData(varSelected) & """, "
Next varSelected
strSQL = ""
strSQL = strSQL & "UPDATE CARDSTOCK_ACCOUNTABILITY " & _
strSQL = strSQL & "SET CLERK_CARD_ISSUED_TO = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE CLERK_CARD_ISSUED_TO IN (" &
strSQL = strSQL & Left$(strWhere, Len(strWhere) - 2) & ")"
CurrentDb.Execute strSQL
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End If

End Sub

If you get the same error again, try putting

Debug.Print strSQL

immediately above the line CurrentDb.Execute strSQL

After the code runs, go to the Immediate window (Ctrl-G) and see what's
printed there.

 

[Douglas J. Steele]

You took out the

strSQL = ""

that you used to have after the For Each statement.

Incidentally, while you've done the right thing (in my opinion) eliminating
the spaces, you could have got around the problem by putting square brackets
around the name: [CARDSTOCK ACCOUNTABILITY]

 

[Aric Green]

I have made the changes and added Debug.Print strSQL. After running the code
False is in the immediate window. Any idea what might be causing this?

 

[Douglas J. Steele]

That's just not possible given the code you're showing! Are you sure that's
the exact code you're running?

 

[Aric Green]

It is not making any sense to me either. The error is looking for a table or
query called 'false' (I think). There is no reference to that in the code
that I can see and no table or form called that. Here is all of the code
that I am running for the Form. The form is opened by another form called
frmAdminLogon. This is a login form that is unbound with a username combobox
and a password text box. It also contains a go button and a cancel button.
I don't think this form could have anything to do with the error I am getting
but I just want to give you more info because I may be missing something.
Under the code directly below is the code for the login form.
=======
Option Compare Database

Private Sub ADD_NEW_CARDS_TO_DATABASE_Click()
DoCmd.OpenQuery "CLEAR IMPORT NEW CARDSTOCK TABLE", acViewNormal
DoCmd.TransferSpreadsheet acImport, , "IMPORT NEW CARDSTOCK",
"z:\Desktop\ID CARDS NEW CARD STOCK.xls", -1
DoCmd.OpenQuery "COPY NEW CARDSTOCK TO ACCOUNTABILITY TABLE", acViewNormal
End Sub

Private Sub ASSIGN_USER_TO_CARDS_Click()
'Dim db As Database
'Dim rec As Recordset
'Dim varSelected As Variant
'Dim strSQL As String
'Set db = CurrentDb()
'Set rec = db.OpenRecordset("tblCardstockAccountability")
' For Each varSelected In Me!List9.ItemsSelected
' strSQL = strSQL & " Update tblCardstockAccountability "
' strSQL = strSQL & " SET strClerkCardIssuedTo = """ & Me.cmb11 & """"
' strSQL = strSQL & " WHERE strClerkCardIssuedTo = """ &
Me!List9.ItemData(varSelected) & """"
' CurrentDb.Execute strSQL
' Next varSelected
'Set db = Nothing ' Clear db...
'MsgBox ("This data is now in your table..")
Dim db As Database
Dim rec As DAO.Recordset
Dim strWhere As String
Dim varSelected As Variant
Dim strSQL As String
Set db = CurrentDb()
Set rec = db.OpenRecordset("tblCardstockAccountability")
If Me!List9.ItemsSelected.Count > 0 Then
For Each varSelected In Me!List9.ItemsSelected
strWhere = strWhere & """" & Me!List9.ItemData(varSelected)
& """, "
Next varSelected
strSQL = ""
strSQL = strSQL & "UPDATE tblCardstockAccountability " & _
strSQL = strSQL & "SET strClerkCardIssuedTo = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE strClerkCardIssuedTo IN (" & strSQL = strSQL &
Left$(strWhere, Len(strWhere) - 2) & ")"
Debug.Print strSQL
CurrentDb.Execute strSQL
Set db = Nothing ' Clear db...
MsgBox ("This data is now in your table..")
End If
End Sub

Private Sub Form_Open(Cancel As Integer)
DoCmd.Maximize
End Sub
=======
code for login form
=======
Option Compare Database
Private intLogonAttempts As Integer

Private Sub Command11_Click()
DoCmd.OpenForm "MAIN MENU", acNormal
DoCmd.Close acForm, "frmAdminLogon", acSaveYes
End Sub

Private Sub Form_Open(Cancel As Integer)
DoCmd.Restore
'On open set focus to combo box
Me.cboEmployee.SetFocus
End Sub

Private Sub cboEmployee_AfterUpdate()
'After selecting user name set focus to password field
Me.txtPassword.SetFocus
End Sub

Private Sub cmdLogin_Click()

'Check to see if data is entered into the UserName combo box

If IsNull(Me.cboEmployee) Or Me.cboEmployee = "" Then
MsgBox "You must enter a User Name.", vbOKOnly, "Required Data"
Me.cboEmployee.SetFocus
Exit Sub
End If

'Check to see if data is entered into the password box

If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
Me.txtPassword.SetFocus
Exit Sub
End If

'Check value of password in tblEmployees to see if this matches value chosen
in combo box

If Me.txtPassword.Value = DLookup("strEmpPassword", "tblEmployees",
"[lngEmpID]=" & Me.cboEmployee.Value) Then

lngMyEmpID = Me.cboEmployee.Value

'Close logon form and admin page

DoCmd.Close acForm, "frmAdminLogon", acSaveNo
'DoCmd.OpenForm "frmSplash_Screen"
DoCmd.OpenForm "CARDSTOCK ADMIN PAGE"

Else
MsgBox "Password Invalid. Please Try Again", vbOKOnly, "Invalid
Entry!"
Me.txtPassword.SetFocus
End If

'If User Enters incorrect password 3 times database will shutdown

intLogonAttempts = intLogonAttempts + 1
If intLogonAttempts > 3 Then
MsgBox "You do not have access to this page. Please contact your
system administrator.", vbCritical, "Restricted Access!"
DoCmd.OpenForm "MAIN MENU", acNormal
DoCmd.Close acForm, "frmAdminLogon", acSaveYes
End If

End Sub
=======

 

[Douglas J. Steele]

There's a problem with your code building up the SQL.

You've got

strSQL = ""
strSQL = strSQL & "UPDATE tblCardstockAccountability " & _
strSQL = strSQL & "SET strClerkCardIssuedTo = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE strClerkCardIssuedTo IN (" & strSQL = strSQL &
Left$(strWhere, Len(strWhere) - 2) & ")"

it should be

strSQL = ""
strSQL = strSQL & "UPDATE tblCardstockAccountability " & _
strSQL = strSQL & "SET strClerkCardIssuedTo = """ & Me.cmb11 & """"
strSQL = strSQL & " WHERE strClerkCardIssuedTo IN ("
strSQL = strSQL & Left$(strWhere, Len(strWhere) - 2) & ")"

 

[Douglas J. Steele]

I should add that, unless you just failed to include it, it looks as though
you're not telling VBA to insist that all variables are declared. (You don't
have an Option Explicit line at the top of your code). As far as I'm
concerned, that's one of the most important things to do in your code. It
can save you literally hours of debugging because you missed the fact that a
variable name was mistyped on one line. (True, it wouldn't have helped in
this particular case...)

Add the Option Explicit line to each of your existing modules. Go into the
VB Editor, choose Tools | Options and check the Require Variable Declaration
box. (I believe it's on the first tab). Yes, it may cause you have to go
back and add a bunch of variable declarations that you missed, but believe
me, it'll be worth it in the long run!

 

[Aric Green]

I finally figured it out my Where clause was looking at the
strClerkCardIssuedTo field and it should have been looking at the card number
field. I rewrote the code and it woks like a charm. Thanks for all your
help it is greatly appriciated.
=======
Dim ctl As Control, varselected As Variant, strEmp As String, strWhere As
String, strSql As String
strEmp = Me.cmb11
Set ctl = Me!List9
strSql = "Update tblCardstockAccountability SET strClerkCardIssuedTo ='"
& strEmp & "'"
For Each varselected In ctl.ItemsSelected
strWhere = " Where [CARD NUMBER] = " & "'" & ctl.ItemData(varselected) &
"'"
DoCmd.RunSQL strSql & strWhere
Next varselected
=======