Prevent delete based on date condition

[chinaboy]

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Hello, I have a delete routine below that works great for my purpose. I am trying to stop users from deleting class after a certain date. I have the date field (ExpiredDate)in the tblClasses for each class. When the users selects a class from the listbox which is the class, I want to check the date in the date field. If the date has passed, msgbox stating that and end the process. If not my routine can continue as normal. Can you provide me some assistance on this?

Thanks in advance

[COLOR=#333333][FONT=Verdana]Private Sub CmdDeleteEntry_Click()[/FONT][/COLOR]
Dim strDelete As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset

    ' connect to the Access database
    Set cn = New ADODB.Connection
    myConn = TARGET_DB
    With cn
     .Provider = "Microsoft.ACE.OLEDB.12.0"
     .Open myConn
   End With
   

'     open a recordset
    Set rs2 = New ADODB.Recordset
    
   src = "SELECT * FROM tblClasses WHERE schedule = '" & Me.lstClasses.List(Column, 3) & "'" 

        rs2.Open src, cn, adOpeDynamic, adLockOptimistic

Dim selected As String
Dim answer As Long
Dim RUSure As String



RUSure = InputBox("Do you really want to delete the selected class? Enter Y to delete or N to cancel.")


If RUSure = "y" Or RUSure = "Y" Then
   selected = lstClasses.ListIndex
        If Not selected = -1 Then
             answer = lstClasses.List(selected, 0)
             strDelete = "Delete * FROM tblRegistered Where StudentID =" & answer
             
             rs2.Fields("SlotsTaken") = rs2.Fields("SlotsTaken") - 1 
             rs2.Update

             cn.Execute strDelete
             cn.Close
             MsgBox "Class Deleted"
        Else
             MsgBox "Please select a class to delete."
             cn.Close
        End If
ElseIf RUSure = "N" Or RUSure = "n" Then
    MsgBox "Deleting cancelled."

    cn.Close
Else
    MsgBox "You have entered a wrong value."
'    rs.Close
    cn.Close
End If


 </code>[COLOR=#333333]End Sub[/COLOR]

 

[Legacy 98055]

If I have understood you correctly...

If rs2!ExpiredDate < Date Then
    MsgBox "That class has expired and cannot be deleted."
    rs.Close
    cn.Close
    Exit Sub
Else
    RUSure = InputBox("Do you really want to delete the selected class? Enter Y to delete or N to cancel.")
End If

 

[chinaboy]

If I have understood you correctly...

If rs2!ExpiredDate < Date Then
    MsgBox "That class has expired and cannot be deleted."
    rs.Close
    cn.Close
    Exit Sub
Else
    RUSure = InputBox("Do you really want to delete the selected class? Enter Y to delete or N to cancel.")
End If

I do think you do understand... Where exactly should I replace or insert. I got a run-time error 3021... Saying the record may have been deleted.....Request operation requires a current record. But I do believe you on the right track.

 

[Legacy 98055]

My code example was minimal and does not account for anything beyond your code example. This will at least move in the direction of dealing with a recordset that has no records.

If Not rs.EOF Then
    If rs2!ExpiredDate < Date Then
        MsgBox "That class has expired and cannot be deleted."
        rs.Close
        cn.Close
        Exit Sub
    Else
        RUSure = InputBox("Do you really want to delete the selected class? Enter Y to delete or N to cancel.")
    End If
Else
    'deal with no records here
End If

We'll go back and forth until we get it.

 

[chinaboy]

When I use the updated code and try to delete, it went to msgbox "you have entered a wrong value."

It should be using the selected record from the listbox "lstClasses" based on column 3 then if ExpiredDate has passed, they get msgbox. Want this to happen first. Then if date hasn't passed, then continues. Prompts if they are sure and continues like it does now.


<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Private Sub CmdDeleteEntry_Click()
Dim strDelete As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset

' connect to the Access database
Set cn = New ADODB.Connection
myConn = TARGET_DB
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open myConn
End With


' open a recordset
Set rs2 = New ADODB.Recordset

src = "SELECT * FROM tblClasses WHERE schedule = '" & Me.lstClasses.List(Column, 3) & "'"

If Not rs.EOF Then
If rs2!ExpiredDate < Date Then
MsgBox "That class has expired and cannot be deleted."
rs.Close
cn.Close
Exit Sub
Else
RUSure = InputBox("Do you really want to delete the selected class? Enter Y to delete or N to cancel.")
End If
Else
'deal with no records here
End If



If RUSure = "y" Or RUSure = "Y" Then
selected = lstClasses.ListIndex
If Not selected = -1 Then
answer = lstClasses.List(selected, 0)
strDelete = "Delete * FROM tblRegistered Where StudentID =" & answer

rs2.Fields("SlotsTaken") = rs2.Fields("SlotsTaken") - 1
rs2.Update

cn.Execute strDelete
cn.Close
MsgBox "Class Deleted"
Else
MsgBox "Please select a class to delete."
cn.Close
End If
ElseIf RUSure = "N" Or RUSure = "n" Then
MsgBox "Deleting cancelled."

cn.Close
Else
MsgBox "You have entered a wrong value."
' rs.Close
cn.Close
End If


</code>End Sub

 

[chinaboy]

Tom, this did do the trick. I was putting code in wrong place.

Thanks so much for your help.

 

[chinaboy]

Sorry Tom, This actually did the trick.

Thanks for your help.

If I have understood you correctly...

If rs2!ExpiredDate < Date Then
    MsgBox "That class has expired and cannot be deleted."
    rs.Close
    cn.Close
    Exit Sub
Else
    RUSure = InputBox("Do you really want to delete the selected class? Enter Y to delete or N to cancel.")
End If

 

[chinaboy]

Hi... I am so sorry, I thought this was working but it appears to still be doing the wrong thing.

When I delete try to delete a class that has expired, I still get MsgBox "Do you really want to delete......" That message should not even appear in that case. Actually I get message regardless if the class expired or not. Then I get the msgbox " Class cannot be deleted...." Seems the the code is ignoring the if statement about the date all together.

Can someone again help me out?

Private Sub CmdDeleteEntry_Click()Dim strDelete As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset


    ' connect to the Access database
    Set cn = New ADODB.Connection
    myConn = TARGET_DB
    With cn
     .Provider = "Microsoft.ACE.OLEDB.12.0"
     .Open myConn
   End With




'     open a recordset
    Set rs2 = New ADODB.Recordset
    
   src = "SELECT * FROM tblClasses WHERE DateTime = '" & Me.lstClasses.List(Column, 3) & "'" 


        rs2.Open src, cn, adOpeDynamic, adLockOptimistic


Dim selected As String
Dim answer As Long
Dim RUSure As String


RUSure = InputBox("Do you really want to delete the selected schedule? Enter Y to delete or N to cancel.")


   selected = lstClasses.ListIndex
    If Not selected = -1 Then
     If rs2![expiredDate] < Date Then
      MsgBox "[COLOR=#333333][I]That class has expired and cannot be deleted[/I][/COLOR]."
'      rs2.Close
'      cn.Close
      Exit Sub
 End If




             If RUSure = "y" Or RUSure = "Y" Then
             answer = lstClasses.List(selected, 0)
             strDelete = "Delete * FROM tblRegistered Where ID =" & answer
             
             rs2.Fields("SlotsTaken") = rs2.Fields("SlotsTaken") - 1 'Reduces slots taken by 1 each time a record is deleted.
             rs2.Update


             cn.Execute strDelete
             cn.Close
             MsgBox "Class Deleted"
         
        Else
             MsgBox "Please select a schedule to delete."
             cn.Close
        End If
ElseIf RUSure = "N" Or RUSure = "n" Then
    MsgBox "Deleting cancelled."
    cn.Close
Else
    MsgBox "You have entered a wrong value."
'    rs.Close
    cn.Close
End If
    
End Sub