当前范围vb 6中的重复错误

时间:2014-02-18 23:31:23

标签: vb6

有人能帮助我吗?我正在尝试在一个表单中显示一个带有两个不同记录集的警报msgbox,因此每当有过期药物时,它将同时显示和警告。但它给我一个错误“当前范围重复的错误” 在这一行

Dim expirationdate As Date
Do While Not Adodc2.Recordset.EOF = True

'----------'

Private Sub Form_Activate()
    Dim expirationdate As Date
    Me.AutoRedraw = True
    Adodc1.Recordset.MoveFirst
    Do While Not Adodc1.Recordset.EOF = True
        With Main
            .Text4.Text = "" & Adodc1.Recordset.Fields("MedicineName")
            .Text1.Text = Adodc1.Recordset.Fields("genericname")
            .Text3.Text = Adodc1.Recordset.Fields("StockQuantity")
            .Combo3.Text = Adodc1.Recordset.Fields("Expmonth")
            .Combo4.Text = Adodc1.Recordset.Fields("Expday")
            .Combo5.Text = Adodc1.Recordset.Fields("Expyear")
        End With
        expirationdate = CDate(Combo3 & "/" & Combo4 & "/" & Combo5)
        datepicker.Value = Format(Now, "MMM-DD-yyyy")
            If datepicker > expirationdate Then
            MsgBox Text4.Text & " is Expired! ", vbExclamation, "Warning"
            If MsgBox("Do you want to dispose " & Text4 & "?", vbQuestion + vbYesNo, "Message") = vbYes Then
                Adodc1.Recordset.Delete
            Else
                Exit Sub
            End If
        End If
    Adodc1.Recordset.MoveNext
    Loop

    '________________'

    Dim expirationdate As Date
    Me.AutoRedraw = True
    Adodc2.Recordset.MoveFirst
    Do While Not Adodc2.Recordset.EOF = True
        With Main
            .Text10 = Adodc2.Recordset.Fields("roomno")
            .Text11 = "" & Adodc2.Recordset.Fields("MedicineName")
            .Text2 = Adodc2.Recordset.Fields("GenericName")
            .Text12.Text = Adodc2.Recordset.Fields("StockQuantity")
            .Combo10 = Adodc2.Recordset.Fields("Expmonth")
            .Combo11 = Adodc2.Recordset.Fields("Expday")
            .Combo12 = Adodc2.Recordset.Fields("Expyear")
        End With

        expirationdate = CDate(Combo10 & "/" & Combo11 & "/" & Combo12)

        datepicker2.Value = Format(Now, "MMM-DD-yyyy")

        If datepicker2 < expirationdate Then
            MsgBox "OK!", vbInformation, "Working"
        Else
            MsgBox "Medicine Expired!.", vbExclamation, " Warning!"

            If MsgBox("Do you want to delete " & Text11 & "?", vbQuestion + vbYesNo, "Message") = vbYes Then
                Adodc2.Recordset.Delete
                Exit Sub
            End If
        End If
        Adodc2.Recordset.MoveNext
    Loop

End Sub

1 个答案:

答案 0 :(得分:1)

试试这个。您有时依赖控件的默认属性。这通常很糟糕,所以我添加了属性。我还删除了Exit Sub行。如果用户点击,您不想退出该子网,则需要继续循环访问Adodc2 Recordset。

Me.AutoRedraw = True
Adodc2.Recordset.MoveFirst
Do While Not Adodc2.Recordset.EOF = True
    With Main
        .Text10.Text = Adodc2.Recordset.Fields("roomno")
        .Text11.Text = "" & Adodc2.Recordset.Fields("MedicineName")
        .Text2.Text = Adodc2.Recordset.Fields("GenericName")
        .Text12.Text = Adodc2.Recordset.Fields("StockQuantity")
        .Combo10.Text = Adodc2.Recordset.Fields("Expmonth")
        .Combo11.Text = Adodc2.Recordset.Fields("Expday")
        .Combo12.Text = Adodc2.Recordset.Fields("Expyear")
    End With

    expirationdate = CDate(Combo10.Text & "/" & Combo11.Text & "/" & Combo12.Text)

    datepicker2.Value = Format(Now, "MMM-DD-yyyy")

    If datepicker2.Value < expirationdate Then
        MsgBox "OK!", vbInformation, "Working"
    Else
        MsgBox "Medicine Expired!.", vbExclamation, " Warning!"
        If MsgBox("Do you want to delete " & Text11.Text & "?", vbQuestion + vbYesNo, "Message") = vbYes Then
            Adodc2.Recordset.Delete
        End If
    End If
    Adodc2.Recordset.MoveNext
Loop