Getting the max and min from ctl.ItemData(varItem)

[Thompyt]

Each time I retype this - it gets shorter.



I am trying to get the max/min of strwhere/strwhere2 so I can use the following: Example [strwhereMin] & " - " & [StrwhereMax]

Public Sub SelectedOOBChanges_Click()
    Dim sSQL As String
    Dim dCRNO As Double
    Dim sngSubNo As Single

    On Error GoTo Broke

    Set objOutlook = CreateObject("Outlook.Application")
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    Set ctl = Me.SelectedOOBNumber    '

    If ctl.ItemsSelected.Count = 0 Then
        MsgBox "Nothing was selected"
    Else

        For Each varItem In ctl.ItemsSelected

            StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
            StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","

            dCRNO = Int(ctl.ItemData(varItem))
            sngSubNo = (ctl.ItemData(varItem) - Int(ctl.ItemData(varItem))) * 100

             sSQL = "UPDATE tblChangeRequest SET tblChangeRequest.Priority = '"  & Me.cboPrty & "', tblChangeRequest.Hr = " & Me.cboHrs
             sSQL = sSQL & " WHERE ((tblChangeRequest.CRNo)=" & dCRNO &  ") AND ((tblChangeRequest.SubNo)=" & sngSubNo & ");"
            CurrentDb.Execute sSQL

        Next varItem

        StrWhere = Left(StrWhere, Len(StrWhere) - 1)
        StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
         
        Set rs = CurrentDb.OpenRecordset("qRecSourceOOBChanges")

        If IsNull(Me.OOBNumber) Then
            MsgBox "There are no OOB CRs."
            TempVars.RemoveAll
            Call subCreateQuery(1)
            DoCmd.Close acForm, "frmEmailAORB"
            DoCmd.OpenForm "frmStart"
        Else

            Labels = Me.cboPrty & " " & [Level] & " OOB Change Request(s)"
                       
            DoCmd.OpenReport "rptOOB", acViewReport, , "OOBNumber IN(" & StrWhere & ")"

             StrHdrMail = "This is a follow-on action from the AORB/CCB/TEWG  discussion on CR(S)" & StrWhere2 & ". If needed, please  back-brief your higher for SA, " _
                         &  "and let us know if there are any issues or concerns. The Change Request  priority is " & Me.cboPrty & " with " & Me.cboHrs & "  hours until " _
                         & "CR(S)" &  StrWhere2 & " is automatically approved (GO OOB Excepted). Please  provide your votes NLT " & DTG & "." & vbCrLf & vbCrLf

            If rs.BOF And rs.EOF Then
                rs.Close
            Else
                rs.MoveLast
                rs.MoveFirst

                Do While Not rs.EOF
                    For Each varItem In ctl.ItemsSelected
                        If rs!OOBNumber = CDbl(ctl.ItemData(varItem)) Then

                             strBdyMail = strBdyMail & "Date Issue Identified:" & Chr(9)  & Chr(9) & rs!Dates & Chr(9) & Chr(9) & "Days Open:"  & Chr(9) & rs!DaysOpen & vbCrLf _
                                          & "Priority: " & Chr(9) & Chr(9) & Chr(9) &  rs!Priority & vbCrLf _
                                          & "CR Number: " & Chr(9) & Chr(9) & Chr(9) &  rs!OOBNumber & vbCrLf & vbCrLf _
                                         & "AO Recommendation: " & Chr(9) & Chr(9) & rs!AOVote & vbCrLf _
                                          & "O6 Recommendation: " & Chr(9) & Chr(9) & rs!O6Vote  & vbCrLf & vbCrLf _
                                          & "Change Requested: " & Chr(9) & Chr(9) &  PlainText(rs![ChangeRequested]) & vbCrLf & vbCrLf _
                                         & "Unit & Section: " & Chr(9) & rs!Unitss & vbCrLf _
                                          & "MTOE Para & Bumper: " & Chr(9) & Chr(9) &  rs![MTOEParass] & vbCrLf & vbCrLf _
                                         & "Rationale: " & PlainText(rs!Rationale) & vbCrLf & vbCrLf _
                                         & "Notes: " & PlainText(rs!NOTES) & vbCrLf _
                                         & "Action Items: " & PlainText(rs!ActionItems) & vbCrLf _
                                          &  "__________________________________________________________________________"  & vbCrLf & vbCrLf
                        End If

                    Next
                    rs.MoveNext
                Loop

                With objOutlookMsg
                    .Subject = NIE & " - " & Labels & " " & StrWhere2 & " - " & Tod
                    .Body = StrHdrMail & strBdyMail & SigBlock
                     DoCmd.OutputTo 3, "rptOOB", acFormatPDF, "C:\Temp\" & NIE & " -  " & Labels & " " & StrWhere2 & " - " & Tod &  ".pdf", , 0
                    .Attachments.Add ("C:\Temp\" &  NIE & " - " & Labels & " " & StrWhere2 & " - " &  Tod & ".pdf")
                    .To = ""
                    .Display
                     Kill "C:\Temp\" & NIE & " - " & Labels & " " &  StrWhere2 & " - " & Tod & ".pdf"

                    DoCmd.Close acForm, "frmOOBChangeSelect"
                    DoCmd.Close acReport, "rptOOB"
                    DoCmd.OpenForm "frmStart"
                End With

            End If
        End If
    End If
    
Broke_Exit:
    On Error Resume Next

    Set ctl = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
    Set objOutlookAttach = Nothing
    Set rs = Nothing
    Exit Sub

Broke:
    If Err.Number = "287" Then
         MsgBox "You selected No to the Outlook security warning. Rerun the  procedure and click Yes to access e-mail addresses to send your  message."
    Else
        MsgBox Err.Number & " " & Err.Description
    End If

    Resume Broke_Exit:

End Sub

[NTC]

you should DIM the strwhere as a string (and also 2)

the first definition should not include itself: StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"

other later definitions can - in order to append info - but not the first

it is not clear to me what is meant by a max or min in regard to the StrWhere; if you mean the value it calls/refers - you probably should establish that separately before including it inside StrWhere clause