秒执行循环时不执行

问题描述 投票:0回答:1

我有一个使用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`
vba ms-access access-vba
1个回答
0
投票

尝试执行rs.MoveFirst之前,请添加Do While ... Loop

因为第一个循环将记录集保留在最后一个条目上,所以第二个循环永远不会执行,因为记录集已经在最后一个记录上。

为此,为什么仅查询记录集以测试重复项并根据结果返回消息,为什么浪费时间循环记录集?

© www.soinside.com 2019 - 2024. All rights reserved.