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. I'm sure that something else in the database has
changed over the past months, but what exactly that would have caused this
not to work, I can't figure out.
Can someone help - please!
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
If IsNull(Me.cboCurrentSupId) Or IsNull(Me.cboNewSupID) Then
msg = "You must select a current Supervisor"
msg = msg & " and another Supervisor you want"
msg = msg & " to reassign Employees to."
MsgBox msg, vbInformation, "Reassign Supervisor"
End If
If Me.lstEmployees.ItemsSelected.Count = 0 Then
MsgBox "You must select as least one Employee to reassign.",
vbInformation
Exit Sub
End If
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
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. I'm sure that something else in the database has
changed over the past months, but what exactly that would have caused this
not to work, I can't figure out.
Can someone help - please!
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
If IsNull(Me.cboCurrentSupId) Or IsNull(Me.cboNewSupID) Then
msg = "You must select a current Supervisor"
msg = msg & " and another Supervisor you want"
msg = msg & " to reassign Employees to."
MsgBox msg, vbInformation, "Reassign Supervisor"
End If
If Me.lstEmployees.ItemsSelected.Count = 0 Then
MsgBox "You must select as least one Employee to reassign.",
vbInformation
Exit Sub
End If
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