Positive Test Flagging & Reminders

[yrstruly]

I am developing a Microsoft Access-based system to manage virus/bacterial retesting for plant blocks. The system tracks testing schedules, flags positive tests, and automates retest reminders using VBA and a subform to display test records.
Files(upload function dont work)https://drive.google.com/file/d/1I5F...ew?usp=sharing


✅ What I Have Done So Far



1️⃣ Created a Table for Retesting (TblBlockRetesting)

Subform: QfrmBlockPath_subform - Link & Functionality

• This subform is embedded in the Blocks Administration Form (frmBlocks Admin).
• It is linked to the main form using:
  
  • Master Field: Nr
  • Child Field: Nr, Block

Testing Reminder - How It Works

✅ Checks if a block has tested positive (TestResult = "A/EC").
✅ Looks at the TestDate column to determine if the test was 5+ years ago.
✅ Inserts overdue tests into TblBlockRetesting if not already recorded.
✅ Triggers a pop-up reminder listing overdue blocks.

I tried this VBA code,it is currently calling a previous Macro, dont know how to get rid of it.

Private Sub Form_Open(Cancel As Integer)

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sqlQuery As String
    Dim testDateThreshold As Date
    Dim blockNr As Long
    Dim virusType As String
    Dim originalTestDate As Date
    Dim retestDueDate As Date
    Dim retestExists As Variant
    Dim messageText As String
    
    ' Set the date threshold (5 years ago from today)
    testDateThreshold = DateAdd("yyyy", -5, Date)


    ' Open the current database
    Set db = CurrentDb()


    ' SQL query to find blocks that tested positive (A/EC) 5+ years ago
    sqlQuery = "SELECT Nr, Block, TestResult, TestDate FROM TblBlocks " & _
               "WHERE TestResult='A/EC' AND TestDate <= #" & Format(testDateThreshold, "MM/DD/YYYY") & "#"


    Set rs = db.OpenRecordset(sqlQuery, dbOpenDynaset)


    ' Initialize message text
    messageText = "The following blocks require retesting:" & vbCrLf & vbCrLf


    ' Check if records exist
    If Not rs.EOF Then
        While Not rs.EOF
            blockNr = rs!Nr
            virusType = "A/EC" ' Since we are filtering for this specific test result
            originalTestDate = rs!TestDate
            retestDueDate = DateAdd("yyyy", 5, originalTestDate)
            
            ' Check if this block is already in the Retest Schedule table
            retestExists = Nz(DLookup("Nr", "TblBlockRetesting", "Nr=" & blockNr & " AND VirusType='" & virusType & "'"), 0)


            ' If the block is not already scheduled for retesting, insert it
            If retestExists = 0 Then
                db.Execute "INSERT INTO TblBlockRetesting (Nr, BlockName, VirusType, OriginalTestDate, NextDueDate, Retest_Status) " & _
                           "VALUES (" & blockNr & ", '" & rs!Block & "', '" & virusType & "', #" & Format(originalTestDate, "MM/DD/YYYY") & "#, #" & Format(retestDueDate, "MM/DD/YYYY") & "#, 'Due');"
            End If


            ' Add block info to the message pop-up
            messageText = messageText & "Block Nr: " & blockNr & " | Block: " & rs!Block & _
                          " | Due Date: " & retestDueDate & vbCrLf


            ' Move to next record
            rs.MoveNext
        Wend


        ' Show pop-up reminder
        MsgBox messageText, vbExclamation, "Retesting Alert"
    Else
        MsgBox "No blocks require retesting.", vbInformation, "Retesting Check Complete"
    End If


    ' Close resources
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

[June7]

Where is the call to a macro?

Why don't you attach files to post as instructed in other thread and at bottom of my post?

[jojowhite]

cross posted here:
Positive Test Flagging & Reminders | Access World Forums

[yrstruly]

I am having great difficculty uploading anything on this site. I have changed browsers and followed your steps on how to attached, nothings works. Thats why i am posting links.

When i try to run this code below, you will see that a previous Macro 'CreateDocumentStorageTable' pops up and i just cant get rid of it.Please assist.

Option Compare Database

Private Sub Form_Open(Cancel As Integer)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sqlQuery As String
    Dim testDateThreshold As Date
    Dim blockNr As Long
    Dim blockName As String
    Dim virusType As String
    Dim originalTestDate As Date
    Dim retestDueDate As Date
    Dim retestExists As Variant
    Dim messageText As String
    
    ' Set the date threshold (5 years ago from today)
    testDateThreshold = DateAdd("yyyy", -5, Date)


    ' Open the current database
    Set db = CurrentDb()


    ' SQL query to find blocks that tested positive (A/EC) 5+ years ago
    sqlQuery = "SELECT Nr, Block, TestResult, TestDate FROM TblBlocks " & _
               "WHERE TestResult='A/EC' AND TestDate <= #" & Format(testDateThreshold, "MM/DD/YYYY") & "#"


    Set rs = db.OpenRecordset(sqlQuery, dbOpenDynaset)


    ' Initialize message text
    messageText = "The following blocks require retesting:" & vbCrLf & vbCrLf


    ' Check if records exist
    If Not rs.EOF Then
        While Not rs.EOF
            blockNr = rs!Nr
            blockName = rs!Block
            virusType = "A/EC" ' We are filtering for this specific test result
            originalTestDate = rs!TestDate
            retestDueDate = DateAdd("yyyy", 5, originalTestDate)
            
            ' Check if this block is already in the Retest Schedule table
            retestExists = Nz(DLookup("Nr", "TblBlockRetesting", "Nr=" & blockNr & " AND VirusType='" & virusType & "'"), 0)


            ' If the block is not already scheduled for retesting, insert it
            If retestExists = 0 Then
                db.Execute "INSERT INTO TblBlockRetesting (Nr, BlockName, VirusType, OriginalTestDate, NextDueDate, Retest_Status) " & _
                           "VALUES (" & blockNr & ", '" & Replace(blockName, "'", "''") & "', '" & virusType & "', #" & Format(originalTestDate, "MM/DD/YYYY") & "#, #" & Format(retestDueDate, "MM/DD/YYYY") & "#, 'Due');"
            End If


            ' Add block info to the message pop-up
            messageText = messageText & "Block Nr: " & blockNr & " | Block: " & blockName & _
                          " | Due Date: " & Format(retestDueDate, "dd-mmm-yyyy") & vbCrLf


            ' Move to next record
            rs.MoveNext
        Wend


        ' Show pop-up reminder if there are overdue tests
        MsgBox messageText, vbExclamation, "Retesting Alert"
    Else
        MsgBox "No blocks require retesting.", vbInformation, "Retesting Check Complete"
    End If


    ' Close resources
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

[Welshgasman]

I cannot help with the macro issue, but why not test for those records already in the retest table? and exclude them.
Then all the records in the set are to be uploaded?

Could even do it in one query if someone was clever.

[Micron]

Has anyone tried to upload a file lately? I can report that the uploader seems to think about it (there's an arc that rotates) but that file won't upload. There is no message of any kind. The zip seems to be 42 Mb - I can't recall what the max is here. Is it 500 Kb?

[Welshgasman]

Works for me with Chrome.

[Micron]

Thanks. So the limit is 500 kb as I thought. That should explain the problem but there's no error message for FireFox - but there used to be.

[June7]

500kb file, 2mb ZIP folder.

These two files after Compact & Repair then zipping do exceed 2mb, so would have to eliminate some objects from the FE file - there are a BUNCH of them.

But I downloaded your files, again.

None of those macros exist. Nor does the code you posted. Neither of the forms you indicated have Open event code.

Getting past the login roadblocks was a pain but I did get your form to open and do not get the macro popup.

[Micron]

Methinks the be is overly large. It contains queries, code modules and about 166 tables that seem to be about export failures, so a lot of unnecessary overhead. Then there is the data itself - 27 replication fields containing 388,540 records. The file space for that could be as much as 16 times what it could be.

Anyway, I'm guessing that the original issue is that the posted code is in a standard module instead of the form's module.
Normally I don't participate where there is an undeclared cross post. I don't wish to keep monitoring what's going on at the other sites.

A treatise on cross posting for the OP to read
Cross Posting Message

[yrstruly]

How did you approach investigating the duplicate records and the issue with my VBA code not producing any output?

[Micron]

How did you approach investigating the duplicate records and the issue with your VBA code not producing any output?

If that question is directed to me, I have no idea what it means.

[June7]

Did you see post 9?

No one mentioned duplicate records. Micron said "replication fields" - maybe meaning fields with similar names that hold same kind of data. Might have been referring to the sets of fields like LRC, LRCDate, CommentLRC, NS, NSDate, CommentNS, etc. I counted about 44 sets.

[Micron]

None of those macros exist. ( I counted something like 48 macros in the front end?)
Nor does the code you posted. (Quite certain it is in a standard module)
Neither of the forms you indicated have Open event code. ( agreed - at least on the one I checked)

Getting past the login roadblocks was a pain but I did get your form to open and do not get the macro popup.
I just closed the login form then showed the nav pane and went from there. Shouldn't have to log in to check design.

[Micron]

fields with similar names that hold same kind of data. Might have been referring to the sets of fields like LRC, LRCDate, CommentLRC, NS, NSDate, CommentNS, etc. I counted about 44 sets.

No, I meant they are replication id fields (GUID) which take 16 bytes of space for each record. However, checking out what you meant also led me to find at least one OLE object field. I can re-run my code to count those if anyone cares.