0

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

如果 rsDoctorData.RecordCount < 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
4

1 回答 1

0

打开记录集后，您必须使用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
于 2015-06-24T09:58:02.010 回答