Looping through Query Based Recordsets with VB 1

[syoung4]

Please can anyone help me.
I am trying to loop through 6 recordsets and write the results to a table which is used for another program that produces badge ID cards.

I am using Access 97 and would like to put the code as a module and call it from a button.

The problem I am having when I run my code is Data type conversion error. I think it could be the sql based recordsets. But I dont know how to get around this.

This is my Code.

Private Sub btncreatebgecrdtbl_Click()
Dim db As Database
Dim rsMaster As Recordset 'Main Table to write all to
Dim rsPeople As Recordset
Dim rsBTQual As Recordset
Dim rsNRSWAQual As Recordset
Dim rsBtEndorsment As Recordset
Dim rsOtherQuals As Recordset

Set db = CurrentDb
Set rsMaster = db.OpenRecordset("tblBadgeCrdsNew") 'must be just name of output table

Set rsPeople = db.OpenRecordset("SELECT tblBase.BaseName AS Depot," & _
"UCase([FirstName]) & ", " & UCase([Surname]) AS Employee_Name, tblEmployee.EmployeeID," & _
"tblEmployee.JobTitle, tblEmployee.MarconiID, tblBTLicence.BTLicenceID, tblEmployee.CSSID," & _
"tblBTLicence.IssueDate, tblBTLicence.ExpiryDate, tblEmpHistory.DateFinish" & _
"FROM (tblEmployee INNER JOIN tblBTLicence ON tblEmployee.EmployeeID = tblBTLicence.EmployeeID)" & _
"INNER JOIN (tblBase INNER JOIN tblEmpHistory ON tblBase.BaseID = tblEmpHistory.BaseID)" & _
"ON tblEmployee.EmployeeID = tblEmpHistory.EmployeeID" & _
"WHERE (((tblEmpHistory.DateFinish) Is Null")

Set rsBTQual = db.OpenRecordset("SELECT tblAchievement.EmployeeID, tblBTLicenceQual.QualCode " & _
"FROM tblQualification INNER JOIN (tblBTLicenceQual INNER JOIN tblAchievement" & _
"ON tblBTLicenceQual.QualID = tblAchievement.QualID) ON (tblQualification.QualID = tblAchievement.QualID)" & _
"AND (tblQualification.QualID = tblBTLicenceQual.QualID)" & _
"WHERE (((tblBTLicenceQual.Section) = 'BTLicence'" & _
"GROUP BY tblAchievement.EmployeeID, tblBTLicenceQual.QualCode")


Set rsNRSWAQual = db.OpenRecordset("SELECT tblAchievement.EmployeeID, tblBTLicenceQual.QualCode" & _
"FROM tblQualification INNER JOIN (tblBTLicenceQual INNER JOIN tblAchievement ON tblBTLicenceQual.QualID" & _
"= tblAchievement.QualID) ON (tblQualification.QualID = tblAchievement.QualID) AND (tblQualification.QualID" & _
"= tblBTLicenceQual.QualID)" & _
"WHERE (((tblBTLicenceQual.Section) = 'NRSWA'" & _
"GROUP BY tblAchievement.EmployeeID, tblBTLicenceQual.QualCode;")


Set rsOtherQuals = db.OpenRecordset("SELECT tblAchievement.EmployeeID, tblBTLicenceQual.QualCode" & _
"FROM tblQualification INNER JOIN (tblBTLicenceQual INNER JOIN tblAchievement ON tblBTLicenceQual.QualID" & _
"= tblAchievement.QualID) ON (tblQualification.QualID = tblAchievement.QualID) AND (tblQualification.QualID" & _
"= tblBTLicenceQual.QualID)" & _
"WHERE (((tblBTLicenceQual.Section) = 'other'" & _
"GROUP BY tblAchievement.EmployeeID, tblBTLicenceQual.QualCode;")

Set rsBtEndorsment = db.OpenRecordset("SELECT tblBTLicence.EmployeeID," & _
"[QualCode]" & " " & "[Date] AS Endorsements" & _
"FROM tblBTLicence INNER JOIN (tblBTLicenceQual INNER JOIN tblEndorsement" & _
"ON tblBTLicenceQual.QualID = tblEndorsement.QualID) ON tblBTLicence.BTLicenceID = tblEndorsement.BTLicenceID")


'Go to first record of Master loop to delete all existing records. Empty the existing recordset.
rsMaster.MoveFirst
Do Until rsMaster.EOF
rsMaster.Delete
Loop

rsPeople.MoveFirst
'This area collects all the data from the recordsets an populates the rsMaster recordset
Do Until rsPeople.EOF
rsMaster.AddNew
rsMaster!Depot = rsPeople!Depot
rsMaster!Employee_Name = rsPeople!Employee_Name
rsMaster!EmployeeID = rsPeople!EmployeeID
rsMaster!JobTitle = rsPeople!JobTitle
rsMaster!MarconiID = rsPeople!MarconiID
rsMaster!BTLicenceID = rsPeople!BTLicenceID
rsMaster!CSSID = rsPeople!CSSID
rsMaster!IssueDate = rsPeople!IssueDate
rsMaster!rsExpiryDate = rsPeople!ExpiryDate
rsMaster!rsDateFinish = rsPeople!DateFinish
rsMaster!Skillsets = rsBTQual!QualCode
rsMaster!NRWSA = rsNRSWAQual!QualCode
rsMaster!SpecialistSkills = rsOtherQuals!QualCode
rsMaster!Endorsements = rsBtEndorsment!Endorsements

'1st BT Qualifications
Dim strBTQual As String
Do Until rsBTQual.EOF
If rsBTQual!EmployeeID = rsPeople!EmployeeID Then
strBTQual = strBTQual & rsBTQual!QualCode & " "
End If
rsBTQual.MoveNext
Loop
rsMaster!BTQual = strBTQual
rsBTQual.MoveFirst

'2nd NRSWA Qualifications
Dim strNRSWAQual As String
Do Until rsNRSWAQual.EOF
If rsNRSWAQual!EmployeeID = rsPeople!EmployeeID Then
strNRSWAQual = strNRSWAQual & rsNRSWAQual!QualCode & " "
End If
rsNRSWAQual.MoveNext
Loop
rsMaster!BTQual = strNRSWAQual
rsNRSWAQual.MoveFirst

'3rd rsBtEndorsment
Dim strBtEndorsment As String
Do Until rsBtEndorsment.EOF
If rsBtEndorsment!EmployeeID = rsPeople!EmployeeID Then
strBtEndorsment = strBtEndorsment & rsBtEndorsment!Endorsements & " "
End If
rsBtEndorsment.MoveNext
Loop
rsMaster!BTQual = rsBtEndorsment
rsBtEndorsment.MoveFirst

'4th OtherQuals
Dim strOtherQuals As String
Do Until rsOtherQuals.EOF
If rsOtherQuals!EmployeeID = rsPeople!EmployeeID Then
strOtherQuals = strOtherQuals & rsOtherQuals!QualCode & " "
End If
rsOtherQuals.MoveNext
Loop
rsMaster!OtherQuals = strOtherQuals
rsOtherQuals.MoveFirst

'end of loops

rsPeople.MoveNext
Loop
rsMaster.Update





End Sub


I have also tried to define the sql as a string like this.

Private Sub Command0_Click()
Dim db As Database
Dim strsql As String
Dim rsMaster As Recordset 'Main Table to write all too
Dim rsPeople As Recordset
Dim qdf As QueryDef
Dim rsBTQual As Recordset
Dim rsNRSWAQual As Recordset
Dim rsBtEndorsment As Recordset
Dim rsOtherQuals As Recordset

db.Execute ("Create Table tblBadgeCrdsNew2" _
& "Depot text,Employee_Name text,EmployeeID text,JobTitle text,MarconiID text,BtLicenceID Int")



Set db = CurrentDb
' Set rsMaster = db.OpenRecordset("tblBadgeCrdsNew") 'must be just name of output table
Set rsMaster = db.OpenRecordset("tblBadgeCrdsNew2")
' Set rsPeople = db.OpenRecordset("SELECT * from tblEmployee")
strsql = "SELECT tblBase.BaseName AS Depot,"
strsql = strsql & "UCase([FirstName]) & ', ' & UCase([Surname]) AS Employee_Name, tblEmployee.EmployeeID,"
strsql = strsql & "tblEmployee.JobTitle, tblEmployee.MarconiID, tblBTLicence.BTLicenceID, tblEmployee.CSSID,"
strsql = strsql & "tblBTLicence.IssueDate, tblBTLicence.ExpiryDate, tblEmpHistory.DateFinish"
strsql = strsql & " FROM (tblEmployee INNER JOIN tblBTLicence ON tblEmployee.EmployeeID = tblBTLicence.EmployeeID)"
strsql = strsql & "INNER JOIN (tblBase INNER JOIN tblEmpHistory ON tblBase.BaseID = tblEmpHistory.BaseID)"
strsql = strsql & "ON tblEmployee.EmployeeID = tblEmpHistory.EmployeeID"
strsql = strsql & " WHERE (((tblEmpHistory.DateFinish)is null))"

Set rsPeople = db.OpenRecordset(strsql)

By refering setting the recordset to the string but I am not having much success.

Thank you.
regards,
Sid.

 

[JerryKlmns]

syoung4

I haven't found your problem yet (you don't even say at what point the error raises) but
1] Take a look at:

How to concatenate multiple child records into a single value FAQ701-4233

for BT Qualifications, NRSWA Qualifications, rsBtEndorsment & OtherQuals, looping, to concatenate multiple child records into a single value.

2] To delete all records from tblBadgeCrdsNew do use

CurrentDB.Execute "DELETE FROM tblBadgeCrdsNew"

and skip the looping

 

[syoung4]

Thank you for your help.
I have put this code behind a button on an On Click event.
When the button is clicked to run the code this error message is displayed:

Run-time-error '3421'
Data type conversion Error.

I am trying to get the name, Marconi Id and Personal details to be captured in the first rsPeople recordset as these details have to be on the Id Cards.

The other recordsets retreive all the qualifications that each person has attained. This is the QualID field.

Each Category of Qualification has to be on one field.
Sid.

 

[JerryKlmns]

The only convertion I can see, happens here:

UCase([FirstName]) & ", " & UCase([Surname]) AS Employee_Name

in rsPeople. See what happens if you don't use the UCase function.

Or even paste the whole SQL in a new query of access. She hould screem if anything were wrong...

 

[Eupher]

syoung4,

Comment out the error handling in the code of your command button, then post back with the code that breaks.

Ken S.

 

[syoung4]

Thank you so much.
I substituted the quote markes with apostraphies and that fixed it.

I have other errors now with
WHERE (((tblEmpHistory.DateFinish)is null") the is null does not work. But at least I have got over the worst.
Thank you.

regards,
Sid.

 

[JerryKlmns]

?
WHERE tblEmpHistory.DateFinish Is Null

 

[syoung4]

I have managed to debug the recordset part of the code now

" WHERE (((tblEmpHistory.DateFinish)is null))")
I fixed the is null problem it only needed ))")

the last closed bracket closes the sql part off.

I am trying to get the loops working now.

Loop
rsMaster!NRWSA = strNRSWAQual
Loop
rsMaster!Endorsements = rsBtEndorsment
Loop
rsMaster!SpecialistSkills = strOtherQuals

these all give the error message:
the field is too small to add the amount of data you attempted to add. Try inserting or pasting less data.

The fields that these loops write to in the master table are set to 255 text.

 

[syoung4]

I have managed to solve the loops by changing the master table fileds to memo.

This fixed the problem and writes the data to the master table now. But it puts all the qualifications from the table into each of the memo fields instead of only the qualifications for each employeeId.

thank you all for all your help.

 

[JerryKlmns]

When the loop ends set the variable to Empty
strOtherQuals=

 

[syoung4]

Thank you Jerry, this works perfect. I get only the qualifications for each employeeID.

The last Problem I have now is that my code only makes writes one record to the table.

I think its this area where all the loops are written to the table.

Do Until rsPeople.EOF
rsMaster.AddNew
rsMaster!Depot = rsPeople!Depot
rsMaster!Employee_Name = rsPeople!Employee_Name
rsMaster!EmployeeID = rsPeople!EmployeeID
rsMaster!JobTitle = rsPeople!JobTitle
rsMaster!MarconiID = rsPeople!MarconiID
rsMaster!BTLicenceID = rsPeople!BTLicenceID
rsMaster!CSSID = rsPeople!CSSID
rsMaster!IssueDate = rsPeople!IssueDate
rsMaster!ExpiryDate = rsPeople!ExpiryDate
rsMaster!DateFinish = rsPeople!DateFinish
rsMaster!Skillsets = rsBTQual!QualCode
rsMaster!NRWSA = rsNRSWAQual!QualCode
rsMaster!SpecialistSkills = rsOtherQuals!QualCode
rsMaster!Endorsements = rsBtEndorsment!Endorsements

My loop is at the end of the code. Ive tried putting one at the bottom of this code but I cant get it to work.

If I can get this going I'll be up and running.
thank you for all your help.
You have saved me hours of trying to get my code going.
Sid.

 

[JerryKlmns]

Change this

        rsPeople.MoveNext
    Loop
    rsMaster.Update

to

        rsMaster.Update
        rsPeople.MoveNext
    Loop

And also this

  Dim db As Database
  Dim rsMaster As Recordset 'Main Table to write all to
  Dim rsPeople As Recordset
  Dim rsBTQual As Recordset
  Dim rsNRSWAQual As Recordset
  Dim rsBtEndorsment As Recordset
  Dim rsOtherQuals As Recordset

To

  Dim db As DAO.Database
  Dim rsMaster As DAO.Recordset 'Main Table to write all to
  Dim rsPeople As DAO.Recordset
  Dim rsBTQual As DAO.Recordset
  Dim rsNRSWAQual As DAO.Recordset
  Dim rsBtEndorsment As DAO.Recordset
  Dim rsOtherQuals As DAO.Recordset

When you 'll upgrade to A2000 or above you wont have an issues

And don't forget this

CurrentDB.Execute "DELETE FROM tblBadgeCrdsNew"

 

[syoung4]

Thank you jerry the code is now finished and works perfect.
Thank you so much for your time and help.

I didnt know enough about vb to get this going.

Best regards Sid.

 

[JerryKlmns]

Sid, very welcomed.
Thnx for the *