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]
Code:
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