У меня есть код, который просматривает записи, используя цикл do.. while, после чего я хочу снова найти запись на основе другого условия IF, но он будет выполнять только первое do.. while и перепрыгивать через второе
Я пытался закомментировать первый цикл, и второй был выполнен, но он перепрыгивает через некоторое время и выполняет первый, если я удаляю комментарии
Option Compare Database
Option Explicit
Dim code, prodname, QP1_combo, QP1_name, QP1_CAS, component_Type, CONTENT_Lower_limit, BEARBEITER As String
Dim CONTENT, Informationsquelle, Anzahl_Partner, Anhange, Kommentar, end_datum, datum_kunde, datum_dossier, compedium As Variant
Dim CONTENT_Upper_limit, Bearb_Start_Partner, Bearb_End_Partner, profile As Variant
Dim Date_of_entry, Bearb_Start_Datum, Bearb_End_Datum As Variant
Dim Checker As Integer
Dim Duplicate_Checker As Integer
Dim existing As Integer
Private Sub Command0_Click()
Dim db As Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("T_MASTER")
Checker = 0
Duplicate_Checker = 0
existing = 0
'*******************************************************
'Verify that the essential fields have values.
'*******************************************************
If IsNull(Me.txt_code.Value) Then
Checker = MsgBox("Product code cannot be empty", vbOKOnly, "Error")
Me.txt_code.SetFocus
ElseIf IsNull(Me.txt_prodname.Value) Then
Checker = MsgBox("Please enter the product name", vbOKOnly, "Error")
Me.txt_prodname.SetFocus
ElseIf IsNull(Me.txt_QP1_combo.Value) Then
Checker = MsgBox("Please select PURE QP1.", vbOKOnly, "Error")
Me.txt_QP1_combo.SetFocus
ElseIf IsNull(Me.txt_component_Type.Value) Then
Checker = MsgBox("Please select the component type.", vbOKOnly, "Error")
Me.txt_component_Type.SetFocus
ElseIf IsNull(Me.txt_BEARBEITER.Value) Then
Checker = MsgBox("Please fill the bearbeiter field.", vbOKOnly, "Error")
Me.txt_BEARBEITER.SetFocus
End If
'*******************************************************
'Checking for duplicacies in the database.
'*******************************************************
code = Me.txt_code.Value
QP1_combo = Me.txt_QP1_combo.Value
If Checker = 0 Then
Do While Not rs.EOF
If rs("PRODUCT_CODE") = code And rs("PURE_QP1") = QP1_combo Then
Duplicate_Checker = MsgBox("Record already in the database!", vbOKOnly, "Duplicate")
End If
rs.MoveNext
Loop
End If
'*******************************************************
'This is the do while that is not working being executed
'*******************************************************
Do While Not rs.EOF
If rs("PRODUCT_CODE") = code Then
existing = MsgBox("Product code was entered earlier", vbOKOnly, "Duplicate")
End If
rs.MoveNext
Loop
If Checker = 0 And Duplicate_Checker = 0 Then
Call read
Call NewAddition
MsgBox ("Record successfully saved")
End If
End Sub
Sub NewAddition()
Dim db As Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("T_MASTER")
'*******************************************************
'Updating the database.
'*******************************************************
rs.AddNew
rs("PRODUCT_CODE") = code
rs("PRODUCT_NAME") = prodname
rs("PURE_QP1").Value = QP1_combo
rs("PURE_NAME_QP1").Value = QP1_name
rs("PURE_CAS_NR").Value = QP1_CAS
rs("Component_Type").Value = component_Type
rs("CONTENT").Value = CONTENT
rs("CONTENT_lower limit").Value = CONTENT_Lower_limit
rs("CONTENT_upper limit").Value = CONTENT_Upper_limit
rs("Date_of_entry").Value = Date
rs("BEARBEITER").Value = BEARBEITER
rs("Bearb_Start_Datum").Value = Bearb_Start_Datum
rs("Bearb_Start_Partner").Value = Bearb_Start_Partner
rs("Bearb_End_Datum").Value = Bearb_End_Datum
rs("Bearb_End_Partner").Value = Bearb_End_Partner
rs("Anzahl_Partner").Value = Anzahl_Partner
rs("Informationsquelle").Value = Informationsquelle
rs("Anhänge").Value = Anhange
rs("Kommentar").Value = Kommentar
rs("Datum_Statement_Kunde").Value = datum_kunde
rs("Datum_Statement_Dossier").Value = datum_dossier
rs("Profile_Y_N").Value = profile
rs("Compendium_Y_N").Value = compedium
' rs("Thema").Value = topic
rs.Update
End Sub
'*******************************************************
' Reading the values.
'*******************************************************
Sub read()
prodname = Me.txt_prodname.Value
QP1_name = Me.txt_QP1_name.Value
QP1_CAS = Me.txt_QP1_CAS.Value
component_Type = Me.txt_component_Type.Value
CONTENT = Me.txt_content.Value
CONTENT_Lower_limit = Me.txt_CONTENT_Lower_limit.Value
CONTENT_Upper_limit = Me.txt_CONTENT_upper_limit.Value
'Date_of_entry = Me.txt_Date_of_entry.Value
BEARBEITER = Me.txt_BEARBEITER.Value
Bearb_Start_Datum = Me.txt_Bearb_Start_Datum.Value
Bearb_Start_Partner = Me.txt_Bearb_Start_Partner.Value
Bearb_End_Datum = Me.txt_Bearb_End_Datum.Value
Bearb_End_Partner = Me.txt_Bearb_End_Partner.Value
Anzahl_Partner = Me.txt_Anzahl_Partner.Value
Informationsquelle = Me.txt_Informationsquelle.Value
Anhange = Me.txt_Anhange.Value
Kommentar = Me.txt_Kommentar.Value
datum_kunde = Me.txt_datum_kunde.Value
datum_dossier = Me.txt_datum_dossier.Value
profile = Me.txt_profile.Value
compedium = Me.txt_compedium.Value
End Sub