Update records in tabled based upon listbox selection/s

[swedbera]

I have used the following successfully in the past. I have not used it in a
couple of months and now it hangs up on the rs.open line and I can't seem to
figure out why. I've tried changing the code and nothing is working for me.
I get rid of one error and get a new error. This is my original code that
did work at one time.

Can someone please take a look and help me with this?

Arlene

Dim rs As New ADODB.Recordset
Dim bRSOpened As Boolean
Dim Cnn As ADODB.Connection
Dim bCnnOpened As Boolean
Dim msg As String, varNumber As Variant

bRSOpened = False
bCnnOpened = False

Set Cnn = CurrentProject.Connection
rs.Index = "PrimaryKey"
rs.Open "tblEmployee", Cnn, adOpenStatic, adLockOptimistic,
adCmdTableDirect
bRSOpened = True
bCnnOpened = True

'Set up the For Each loop throught the collection
For Each varNumber In Me.lstEmployees.ItemsSelected
rs.Seek Me.lstEmployees.ItemData(varNumber), adSeekFirstEQ
rs!SupID = Me.cboNewSupID
rs.Update
Next

Me.cboCurrentSupId = Me.cboNewSupID
Me.cboNewSupID = Null

stSQL = "SELECT tblEmployee.EmpID, tblEmployee.Employee,
qlkp_Supervisors.Supervisor, qlkp_Managers.Manager FROM (tblEmployee LEFT
JOIN qlkp_Supervisors ON tblEmployee.SupID = qlkp_Supervisors.SupId) LEFT
JOIN qlkp_Managers ON tblEmployee.MgrID = qlkp_Managers.MgrID WHERE
qlkp_Supervisors.supid = '" & Me.cboCurrentSupId & "' ORDER BY
tblEmployee.Employee;"

Me.lstEmployees.RowSource = stSQL

CountEmployees

rs.Close
bRSOpened = False
Cnn.Close
bCnnOpened = False
Set Cnn = Nothing

 

[swedbera]

No one has responded, but I have determined that the reason my code no longer
works is due to my splitting the database (FE/BE). Can someone advise me on
how to make this code work now that the database is split. It only works if
the table that is being updated is local.

Thanks in advance

Arlene

 

[Douglas J Steele]

Using SQL to update your table is almost always better than looping through
a recordset to do the same.

Try writing an Update query to do the same thing.

Dim strSQL As String
Dim strWhere As String
Dim varSelected As Variant

strSQL = "UPDATE tblEmployee SET SupID = " & _
Me.cboNewSupID

For Each varSelected In Me.lstEmployees.ItemsSelected
strWhere = strWhere & Me.lstEmployees.ItemData(varNumber) & ", "
Next varSelected

If Len(strWhere) > 0 Then
strSQL = strSQL & " WHERE EmpID IN (" & _
Left$(strWhere, Len(strWhere) - 2) & ")"
End If

You can then use a Command object to run that SQL.

This assumes that both SupID and EmpID are numeric fields.

 

[swedbera]

Hi Doug,

Thank you again for coming to my rescue! I'm ready to tear my hair out if I
can't resolve this soon.

I use this for three different forms (Managers, Supervisors and Sites). I
added the code sample you provided and removed all of the open connection and
recordset lines. I tried to run it and got an error message:

Data Type mismatch in criteria expression - 3464

Please take a look and tell me what I am doing wrong here. Everything
worked great until I split the database into a FE/BE. I tried deleting the
linked table and importing it in from the BE - then ran my original code. It
still worked. I don't understand why it would not work just because that
table is now linked from the BE.

Please help!!!

Arlene

My code is now as follows:

Private Sub cmdAssignManager_Click()
On Error GoTo ErrHandler

Dim strSQL As String
Dim strWhere As String
Dim varSelected As Variant

If IsNull(Me.cboNewMgrId) Then
MsgBox "You must select a New manager.", vbInformation, "Assign
Manager"
Exit Sub
End If

If Me.lstEmployees.ItemsSelected.Count = 0 Then
MsgBox "You must select as least one Employee.", vbInformation,
"Assign Manager"
Exit Sub
End If

strSQL = "UPDATE tblEmployee SET MgrId = " & Me.cboNewMgrId
For Each varSelected In Me.lstEmployees.ItemsSelected
strWhere = strWhere & Me.lstEmployees.ItemData(varSelected) & ", "
If Len(strWhere) > 0 Then
strSQL = strSQL & " WHERE EmpID IN (" & _
Left$(strWhere, Len(strWhere) - 2) & ")"
End If
DoCmd.RunSQL strSQL
Next varSelected

Me.cboCurrentMgrId = Me.cboNewMgrId
Me.cboNewMgrId = Null

stSQL = "SELECT tblEmployee.EmpID, tblEmployee.Employee,
qlkp_Supervisors.Supervisor, qlkp_Managers.Manager FROM (tblEmployee LEFT
JOIN qlkp_Supervisors ON tblEmployee.SupID = qlkp_Supervisors.SupId) LEFT
JOIN qlkp_Managers ON tblEmployee.MgrID = qlkp_Managers.MgrID WHERE
qlkp_Managers.MgrId = '" & Me.cboCurrentMgrId & "' ORDER BY
tblEmployee.Employee;"
Me.lstEmployees.RowSource = stSQL

CountEmployees

ExitHandler:
Exit Sub

ErrHandler:
MsgBox "Please record this information: " & Err.Description & " " &
Err.Number & " " & Err.Source, vbCritical
Resume ExitHandler

End Sub

 

[swedbera]

Nevermind my previous message. I got it working again.

Thanks so much for your help!!!!

Arlene