Arrgghhh... ADODB Connection and 3265, 3021

Joined
Sep 5, 2007
Messages
4
Reaction score
0
Okay, I'm pretty new to VBA, and thought maybe I could get some help on here. I'm working on an excel application that sends SQL queries to an Access Database. I already have a nice section of the project working well, but for whatever reason, when I'm working on one form in particular, I get errors with the ADO connection: 3265, Item not found in this collection; and 3021, EOF or BOF is True. I simplified down the SQL query in the non-working code, so that I could make sure myself that it was not that. I'll copy in both my non-working code and my working code. Any help or ideas are SUPER appreciated.

NON-FUNCTIONING CODE:

Private Sub cmdSubmit_Click()
On Error GoTo cmdSubmit_Click_Err
Dim SIP As New ADODB.Connection
Dim managerSearch As New ADODB.Recordset
Dim managerLastName As String
SIP.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=S:\Fin and Corporate\Skills Inventory Project\SDLC_PMLC\Database\SIPDB.mdb"

If Me.cboSearchCriteria.Value = "Resource Manager" Then

managerLastName = Me.cboCriteriaChoices.Value

lboxResults.Clear
lboxResults.AddItem "FID"
lboxResults.Column(1, lboxResults.ListCount - 1) = "Last Name"
lboxResults.Column(2, lboxResults.ListCount - 1) = "First Name"
managerSearch.Open "SELECT Employees.LastName_Emp, Employees.FirstName_Emp, Employees.Id_emp FROM Employees WHERE Employees.Id_emp = '" & managerLastName & "';", _
SIP, adOpenStatic
managerSearch.MoveFirst
With Me.lboxResults
Do
.AddItem managerSearch![Employees.Id_emp]
.Column(1, lboxResults.ListCount - 1) = managerSearch![LastName_Emp]
.Column(2, lboxResults.ListCount - 1) = managerSearch![FirstName_Emp]
managerSearch.MoveNext
Loop Until managerSearch.EOF
End With
End If

cmdSubmit_Click_Exit:
On Error Resume Next
managerSearch.Close
SIP.Close
Set managerSearch = Nothing
Set SIP = Nothing
Exit Sub
cmdSubmit_Click_Err:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume cmdSubmit_Click_Exit

WORKING CODE:

Private Sub cmdSubmit_Click()
On Error GoTo cmdSubmit_Click_Err
Dim SIP As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim expert As New ADODB.Recordset
Dim strCategory As String
Dim strSkill As String
Dim strExpert As String
Dim numExpert As Integer


strCategory = Me.cboCategory.Value
strSkill = Me.cboSkill.Value
strExpert = Me.cboExpertise.Value

lboxResults.Clear
lboxResults.AddItem "FID"
lboxResults.Column(1, lboxResults.ListCount - 1) = "Last Name"
lboxResults.Column(2, lboxResults.ListCount - 1) = "First Name"
lboxResults.Column(3, lboxResults.ListCount - 1) = "Level"
lboxResults.Column(4, lboxResults.ListCount - 1) = "Certifications"
lboxResults.Column(5, lboxResults.ListCount - 1) = "Year Last Used"
lboxResults.Column(6, lboxResults.ListCount - 1) = "Comments"


SIP.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=S:\Fin and Corporate\Skills Inventory Project\SDLC_PMLC\Database\SIPDB.mdb"

expert.Open "SELECT Expertise.Id_Expertise, Expertise.Level_Expertise FROM Expertise WHERE Expertise.Level_Expertise= '" & strExpert & "';", _
SIP, adOpenStatic

numExpert = expert![Id_Expertise] - 1

rst.Open "SELECT Employees.LastName_Emp, Emp_Skill.Certification_Emp_Skill, Emp_Skill.YearLastUsed_Emp_Skill, Employees.FirstName_Emp, Employees.Title_Emp, Emp_Skill.Comments_Emp_Skill, Categories.Id_Ctgy, Skills.Id_Ctgy, Skills.Id_Skill, Emp_Skill.Id_Skill, Expertise.Id_expertise, Emp_Skill.SkillLevel_Emp_Skill, Employees.Id_emp, Emp_Skill.Id_Emp, Categories.Desc_ctgy, Skills.Name_Skills, Expertise.Level_Expertise FROM Employees, Emp_Skill, Categories, Skills, Expertise WHERE Categories.Id_Ctgy = Skills.Id_Ctgy AND Skills.Id_Skill = Emp_Skill.Id_Skill AND Expertise.Id_expertise = Emp_Skill.SkillLevel_Emp_Skill AND Employees.Id_Emp = Emp_Skill.Id_Emp AND Categories.Desc_Ctgy = '" & strCategory & "' AND Skills.Name_Skills = '" & strSkill & "' AND Expertise.Id_Expertise > " & numExpert & " ORDER BY Employees.LastName_Emp;", _
SIP, adOpenStatic
rst.MoveFirst
With Me.lboxResults
Do
.AddItem rst![Employees.Id_emp]
.Column(1, lboxResults.ListCount - 1) = rst![LastName_Emp]
.Column(2, lboxResults.ListCount - 1) = rst![FirstName_Emp]
.Column(3, lboxResults.ListCount - 1) = rst![Level_Expertise]
.Column(4, lboxResults.ListCount - 1) = rst![Certification_Emp_Skill]
.Column(5, lboxResults.ListCount - 1) = rst![YearLastUsed_Emp_Skill]
.Column(6, lboxResults.ListCount - 1) = rst![Comments_Emp_Skill]

rst.MoveNext
Loop Until rst.EOF
End With
cmdSubmit_Click_Exit:
On Error Resume Next
expert.Close
rst.Close
SIP.Close
Set expert = Nothing
Set rst = Nothing
Set SIP = Nothing
Exit Sub
cmdSubmit_Click_Err:
If Err.Number = 3021 Then
MsgBox "There are no employees who possess this expertise." _
, , "No Employees With Skill!"
Resume cmdSubmit_Click_Exit
Else
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume cmdSubmit_Click_Exit
End If
End Sub
 

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