VBA 记录计数问题

Question

由于某种原因，以下部分代码不起作用。

如果 rsDoctorData.RecordCount

我希望它在少于 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