VBA RecordCount Issue

Question

For some reason the below part of the code isn't working.

If rsDoctorData.RecordCount < 800 Then

I want it to display a message when there are less than 800 records. I've read I need to go to the last record to get the record count but I'm uncertain how to get it to work.

Any thoughts/advice are welcome

Thanks for your help in advance.

Dim db As DAO.Database
Dim rsDoctorData As DAO.Recordset
Dim rsDoctorContact As DAO.Recordset
Dim strSQLDoctor800 As String
Dim strSQLDoctorContact As String

Dim DoctorID As Integer
Dim DoctorName As String
Dim ContactTaken As Boolean

strSQLDoctor800 = "SELECT TOP 800 tbl_Full_Data_Doctor.ID_Full_Data, Rnd  ([ID_Full_Data]) AS Random, tbl_Full_Data_Doctor.Reference,     tbl_Full_Data_Doctor.id_Site, tbl_Full_Data_Doctor.id_Local, tbl_Full_Data_Doctor.Date, tbl_Full_Data_Doctor.Time, tbl_Full_Data_Doctor.Age, tbl_Full_Data_Doctor.Gender, tbl_Full_Data_Doctor.Complaint, tbl_Full_Data_Doctor.LTM_Medicine, tbl_Full_Data_Doctor.Specialty, tbl_Full_Data_Doctor.Category, tbl_Full_Data_Doctor.Add_Training, tbl_Full_Data_Doctor.Comments, tbl_Full_Data_Doctor.Taken, tbl_Full_Data_Doctor.Second_Cat_Contact_id, tbl_Full_Data_Doctor.Second_Cat_Contact_Name" _
    & " FROM tbl_Full_Data_Doctor " _
    & " WHERE (((tbl_Full_Data_Doctor.Taken) = False)) " _
    & " ORDER BY Rnd([ID_Full_Data]); "

strSQLDoctorContact = "SELECT TOP 1 tbl_Contacts.ID, tbl_Contacts.idSite, tbl_Contacts.role, tbl_Contacts.name, tbl_Contacts.email, tbl_Contacts.phone, tbl_Contacts.involvement, tbl_Contacts.Taken" _
& " FROM tbl_Contacts " _
& " WHERE (((tbl_Contacts.role)= 'Doctor') AND ((tbl_Contacts.involvement)=True) AND ((tbl_Contacts.Taken)=False)); "


Set db = CurrentDb
Set rsDoctorData = db.OpenRecordset(strSQLDoctor800)
Set rsDoctorContact = db.OpenRecordset(strSQLDoctorContact)

If rsDoctorContact.RecordCount <> 0 Then

DoctorID = DLookup("[ID]", "qry_Doctor_Contact_Taken")
DoctorName = DLookup("[name]", "qry_Doctor_Contact_Taken")
ContactTaken = DLookup("[Taken]", "qry_Doctor_Contact_Taken")

        If rsDoctorData.RecordCount < 800 Then

            While Not rsDoctorData.EOF

                With rsDoctorData
                    .Edit
                    .Fields("Taken") = 1
                    .Fields("Second_Cat_Contact_id") = DoctorID
                    .Fields("Second_Cat_Contact_name") = DoctorName
                    .Update
                    rsDoctorData.MoveNext

                End With

            Wend

                DoCmd.SetWarnings (False)

                    DoCmd.OpenQuery "upd_Doctor_Taken"

                DoCmd.SetWarnings (True)

        Else

            MsgBox "There are no more 800 records to update.", vbCritical

        End If

    [Forms]![frm_Randomise].Refresh

Else

    MsgBox "There are no Doctors to assign", vbCritical, "PIED Project"

End If

Set rsDoctorData = Nothing
Set rsDoctorContact = Nothing
Set db = Nothing

End Sub

Answer 1

After you have opened the recordset, you have to move to the last record using the MoveLast method, then go back to the first record using the MoveFirst. Then you get the count, which would be accurate. Something like.

Dim db As DAO.Database
Dim rsDoctorData As DAO.Recordset
Dim rsDoctorContact As DAO.Recordset
Dim strSQLDoctor800 As String
Dim strSQLDoctorContact As String

Dim DoctorID As Integer
Dim DoctorName As String
Dim ContactTaken As Boolean

strSQLDoctor800 = "SELECT TOP 800 tbl_Full_Data_Doctor.ID_Full_Data, Rnd  ([ID_Full_Data]) AS Random, tbl_Full_Data_Doctor.Reference,     " & _
                  "tbl_Full_Data_Doctor.id_Site, tbl_Full_Data_Doctor.id_Local, tbl_Full_Data_Doctor.Date, tbl_Full_Data_Doctor.Time, tbl_Full_Data_Doctor.Age, " & _
                  "tbl_Full_Data_Doctor.Gender, tbl_Full_Data_Doctor.Complaint, tbl_Full_Data_Doctor.LTM_Medicine, tbl_Full_Data_Doctor.Specialty, " & _
                  "tbl_Full_Data_Doctor.Category, tbl_Full_Data_Doctor.Add_Training, tbl_Full_Data_Doctor.Comments, tbl_Full_Data_Doctor.Taken, " & _
                  "tbl_Full_Data_Doctor.Second_Cat_Contact_id, tbl_Full_Data_Doctor.Second_Cat_Contact_Name " _
                & " FROM tbl_Full_Data_Doctor " _
                & " WHERE (((tbl_Full_Data_Doctor.Taken) = False)) " _
                & " ORDER BY Rnd([ID_Full_Data]); "

strSQLDoctorContact = "SELECT TOP 1 tbl_Contacts.ID, tbl_Contacts.idSite, tbl_Contacts.role, tbl_Contacts.name, tbl_Contacts.email, tbl_Contacts.phone, " & _
                      "tbl_Contacts.involvement, tbl_Contacts.Taken" _
                    & " FROM tbl_Contacts " _
                    & " WHERE (((tbl_Contacts.role)= 'Doctor') AND ((tbl_Contacts.involvement)=True) AND ((tbl_Contacts.Taken)=False)); "

Set db = CurrentDb
Set rsDoctorData = db.OpenRecordset(strSQLDoctor800)
Set rsDoctorContact = db.OpenRecordset(strSQLDoctorContact)

If rsDoctorContact.RecordCount <> 0 Then
    If rsDoctorData.RecordCount <> 0 Then   
        rsDoctorData.MoveLast
        rsDoctorData.MoveFirst
        If rsDoctorData.RecordCount < 800 Then
            While Not rsDoctorData.EOF
                With rsDoctorData
                    .Edit
                    .Fields("Taken") = 1
                    .Fields("Second_Cat_Contact_id") = DoctorID
                    .Fields("Second_Cat_Contact_name") = DoctorName
                    .Update
                    rsDoctorData.MoveNext
                End With
            Wend

            DoCmd.SetWarnings (False)
            DoCmd.OpenQuery "upd_Doctor_Taken"
            DoCmd.SetWarnings (True)
        Else
            MsgBox "There are no more 800 records to update.", vbCritical
        End If
    End If
[Forms]![frm_Randomise].Refresh
Else
    MsgBox "There are no Doctors to assign", vbCritical, "PIED Project"
End If

Set rsDoctorData = Nothing
Set rsDoctorContact = Nothing
Set db = Nothing