VBA RecordCount问题

Question

由于某种原因，下面的代码部分无效。

如果rsDoctorData.RecordCount＆lt; 800然后

我希望它在少于800条记录时显示一条消息。我读过我需要去最后一条记录才能获得记录，但我不确定如何让它工作。

欢迎任何想法/建议

提前感谢您的帮助。

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

打开记录集后，必须使用MoveLast方法移至最后一条记录，然后使用MoveFirst返回第一条记录。然后你得到计数，这是准确的。像。的东西。

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