Search code examples
vbamessageboxms-access-forms

Message box criteria filter showing all records


I have a button in my main menu form which has to show a reminder that which are all instruments are due for calibration. the criteria is :"show the records which are less than today's date & also +7 days from today" however i can't able to code the latter hence it is showing all future records. below is my code please help.

Private Sub cmddept_Click()
    Dim RS As DAO.Recordset
    Dim strMsg As String
    
    Set RS = CurrentDb.OpenRecordset("select * from (" & Me.RecordSource & ")", dbOpenSnapshot, dbReadOnly)
    
    With RS
        If Not (.BOF And .EOF) Then
            .MoveFirst
            While Not .EOF
                If ![Next_Calibration] > Date - 7 Then
                  strMsg = strMsg & ![EQUIPMENT_number] & vbTab & vbTab & ![Calibrating_agency] & vbTab & vbTab & ![Next_Calibration] & vbCrLf
                End If
                .MoveNext
            Wend
        End If
        .Close
    End With
    Set RS = Nothing
    If strMsg <> "" Then
       strMsg = "You have to Calibrate the following!!!:" & vbCrLf & vbCrLf & _
"------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
"Equipment Name" & vbTab & vTab & "Agency Name" & vTab & vbTab & "Due Date" & vbCrLf & _
"-------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
strMsg
Else
strMsg = "No record to is due for calibration"
End If
    
    MsgBox strMsg, vbInformation + vbOKOnly
End Sub

Solution

  • I would do it this way:

        Set RS = CurrentDb.OpenRecordset("select * from " & Me.RecordSource & " WHERE [Next_Calibration] <= DateAdd('d', 7, Date())", dbOpenSnapshot, dbReadOnly)
        
        With RS
            If Not (.BOF And .EOF) Then
                .MoveFirst
                While Not .EOF
                      strMsg = strMsg & ![EQUIPMENT_number] & vbTab & vbTab & ![Calibrating_agency] & vbTab & vbTab & ![Next_Calibration] & vbCrLf
                    .MoveNext
                Wend
            End If
            .Close
        End With
        Set RS = Nothing
    ' continue with your code