由于某种原因,代码的以下部分不起作用。
如果 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