Get all values for field in query

[Foe]

I've got the following code on a form. The entirety of the sub is listed just in case. The relevant portion is below.

Private Sub Form_Timer() 'timer set to fire once per minute
    'AutoPurge old records (>7yrs) and take action if Hotword and/or NANU expire
    Dim Minute As String
    Minute = Right(Format(TimeValue(Now()), "hh:mm"), 1)
    'Only run these every 10 minutes
    If Minute = "0" Then
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qryPurgeEmail"
        DoCmd.OpenQuery "qryPurgeHotword"
        DoCmd.OpenQuery "qryPurgeIIP"
        DoCmd.OpenQuery "qryPurgeNANU"
        DoCmd.OpenQuery "qryPurgeOutage"
        DoCmd.OpenQuery "qryPurgeWatchLog"
        DoCmd.OpenQuery "qryHotwordUpdateExpired"
        'check if any NANUs will expire before doing it - if yes, notify user
        If DCount("*", "qryNotifyExpiredNANU") = 1 Then
            MsgBox "The NANU " & DLookup("NANUnumber", "qryNotifyExpiredNANU") & " has expired. It has been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
        ElseIf DCount("*", "qryNotifyExpiredNANU") > 1 Then
            MsgBox "The NANUs " & !!!!RETRIEVED VALUE HERE!!!! & " and " & !!!!RETRIEVED VALUE HERE!!!! & " have expired. They Have been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
        End If
        DoCmd.OpenQuery "qryNANUupdateExpired"
        DoCmd.SetWarnings True
        'refresh lists
        Me.listActiveEmails.Requery
        Me.listActiveNANUs.Requery
        Me.listActiveOutages.Requery
        Me.listAllEmail.Requery
        Me.listIIPEmails.Requery
        Me.listWatchLog.Requery
    End If
    'Popup reminders for watch entries
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("qryReminders")
    With rs
        If .RecordCount <> 0 Then
            Do Until .EOF
            MsgBox rs!RemindMessage, vbOKOnly, "Daily Routine Reminder"
            rs.Edit
            rs!LastRemindDate = Date
            rs.Update
            rs.MoveNext
            Loop
        End If
    End With
    rs.Close
End Sub

The part I'm having trouble with follows:

If DCount("*", "qryNotifyExpiredNANU") = 1 Then
   MsgBox "The NANU " & DLookup("NANUnumber", "qryNotifyExpiredNANU") & " has expired. It has been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
ElseIf DCount("*", "qryNotifyExpiredNANU") > 1 Then
   MsgBox "The NANUs " & !!!!RETRIEVED VALUE HERE!!!! & " and " & !!!!RETRIEVED VALUE HERE!!!! & " have expired. They Have been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
End If

The intent of that (incomplete) ElseIf is to provide a list of all NANUnumbers that have expired. When a single NANU expires, the DLookup works perfectly since the query only has one record. But I'm stumped on dealing with anything more than one value.

The desired result is that the value from the NANUnumber field of each resulting record in qryNotifyExpiredNANU would be used to build a string for use in the MsgBox.

Using DLookup is out (I think) because I can't identify which records the query returned to apply a WHERE clause.

I also looked into using Loop with a RecordSet, but can't figure out how to approach it.

So to sum it up, I don't know how to grab each value present in the query and I also don't know how to concatenate a string with a dynamic number of values.

 

[pbaldy]

I'd use a recordset to build a string, which will work whether there's 1 or more, and be more efficient than repeated DLookup's. Inside the loop would look like

strMessage = strMessage & rs!NANUnumber & ", "

 

[Foe]

Does this look right? I'll be testing it shortly.

I still used the DCount = 1 and DCount > 1 due to plurality changes (NANU vs NANUs and it has vs they have).

I also switched your ", " for "and " since it's very unlikely to ever be three results. Its actually pretty unlikely to get two, but I wanted to be prepared for anything.

I then dropped the last 4 characters off the string to remove the last "and ".

If DCount("*", "qryNotifyExpiredNANU") = 1 Then
   MsgBox "The NANU " & DLookup("NANUnumber", "qryNotifyExpiredNANU") & " has expired. It has been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
ElseIf DCount("*", "qryNotifyExpiredNANU") > 1 Then
   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Set db = CurrentDb()
   Set rs = db.OpenRecordset("qryNotifyExpiredNANU")
   Dim strMessage As String
   With rs
      Do Until .EOF
      strMessage = strMessage & rs!NANUnumber & "and "
      rs.MoveNext
      Loop
   End With
   rs.Close
   strMessage = Left(strMessage, Len(strMessage) - 4)
   MsgBox "The NANUs " & strMessage & " have expired. They have been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
End If

Update: I ended up having to move the following lines to the top of the sub since they were also used in the Popup Reminders part of the sub.

   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Set db = CurrentDb()

Both instances got moved to the top. Only the Set RS remain is their respective sections.

 

[pbaldy]

Other than the space problem that will be obvious in the result, it looks fine offhand.

 

[Foe]

Other than the space problem that will be obvious in the result, it looks fine offhand.

touche

strMessage = strMessage & rs!NANUnumber & " and "

and

strMessage = Left(strMessage, Len(strMessage) - 5)

should solve that. I'll know in 7 more minute when it fires again...

Thanks for the help!

 

[Foe]

Everything verified as working.

Completed code follows so others can see complete solution:

Private Sub Form_Timer() 'timer set to fire once per minute
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = CurrentDb()
    'AutoPurge old records (>7yrs) and take action if Hotword and/or NANU expire
    Dim Minute As String
    Minute = Right(Format(TimeValue(Now()), "hh:mm"), 1)
    'Only run these every 10 minutes
    If Minute = "0" Then
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qryPurgeEmail"
        DoCmd.OpenQuery "qryPurgeHotword"
        DoCmd.OpenQuery "qryPurgeIIP"
        DoCmd.OpenQuery "qryPurgeNANU"
        DoCmd.OpenQuery "qryPurgeOutage"
        DoCmd.OpenQuery "qryPurgeWatchLog"
        DoCmd.OpenQuery "qryHotwordUpdateExpired"
        'check if any NANUs will expire before doing it - if yes, notify user
        If DCount("*", "qryNotifyExpiredNANU") = 1 Then
             MsgBox "NANU " & DLookup("NANUnumber", "qryNotifyExpiredNANU") & " has expired. It has been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
        ElseIf DCount("*", "qryNotifyExpiredNANU") > 1 Then
            Set rs = db.OpenRecordset("qryNotifyExpiredNANU")
            Dim strMessage As String
            With rs
                Do Until .EOF
                strMessage = strMessage & rs!NANUnumber & " and "
                rs.MoveNext
                Loop
            End With
            rs.Close
            strMessage = Left(strMessage, Len(strMessage) - 5)
            MsgBox "NANUs " & strMessage & " have expired. They have been removed from the Active NANU list.", vbOKOnly, "NANU Expired"
        End If
        DoCmd.OpenQuery "qryNANUupdateExpired"
        DoCmd.SetWarnings True
        'refresh lists
        Me.listActiveEmails.Requery
        Me.listActiveNANUs.Requery
        Me.listActiveOutages.Requery
        Me.listAllEmail.Requery
        Me.listIIPEmails.Requery
        Me.listWatchLog.Requery
    End If
    'Popup reminders for watch entries
    Set rs = db.OpenRecordset("qryReminders")
    With rs
        If .RecordCount <> 0 Then
            Do Until .EOF
            MsgBox rs!RemindMessage, vbOKOnly, "Daily Routine Reminder"
            rs.Edit
            rs!LastRemindDate = Date
            rs.Update
            rs.MoveNext
            Loop
        End If
    End With
    rs.Close
End Sub

 

[pbaldy]

Happy to help! I would likely do it all with the recordset, as I have an aversion to making too many trips to the data, and you're making 2 or 3. That said, if there isn't too much data, you won't be able to tell the difference.