Another issue evolved from the .EOF Thread. It wasn't noticed until the code worked correctly.
The current issue is saving the control Priority and Hr to the main table. So far all I have been able to do is have it save to the first record in qRecSourceOOBChanges query, no matter the record selected.
I have made the controls Priority and Hours bound to qRecSourceOOBChanges, and unbound.
I have tried to save during the For Each varItem In ctl.ItemsSelected set using DoCmd.RunCommand acCmdSaveRecord and even:
Me.Recordset.Edit
Me.Recordset("Priority") = Prior
Me.Recordset("Hr") = Hours
Me.Recordset.Update
Then I have tried
Do While Not rs.EOF
For Each varItem In ctl.ItemsSelected
If rs!OOBNumber = CDbl(ctl.ItemData(varItem)) Then
If Form_frmOOBChangeSelect.Dirty Then
Form_frmOOBChangeSelect.Dirty = False
DoCmd.RunCommand acCmdSaveRecord
End If
MsgBox CDbl(ctl.ItemData(varItem)) & vbCrLf & Priority & vbCrLf & Hr
With the message box the Priority and Hr remain the same through each selection
but do not show up in the Email body, except if the first record is a selected record. It also doesn't show up in the PDF if one of the selected records is not at the same "Voting" level.
Code:
Public Sub SelectedOOBChanges_Click()
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
DoCmd.RunCommand acCmdSaveRecord
StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
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 or no CR was selected."
TempVars.RemoveAll
Call subCreateQuery(1)
DoCmd.Close acForm, "frmEmailAORB"
DoCmd.OpenForm "frmStart"
Else
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 " & Priority & " with " & Hr & " 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
'If Form_frmOOBChangeSelect.Dirty Then
' Form_frmOOBChangeSelect.Dirty = False
'End If
' MsgBox CDbl(ctl.ItemData(varItem)) & vbCrLf & Priority & vbCrLf & Hr
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) & rs![ChangeRequested] & vbCrLf & vbCrLf _
& "Unit & Section: " & Chr(9) & rs!Unitss & vbCrLf _
& "MTOE Para & Bumper: " & Chr(9) & Chr(9) & rs![MTOEParass] & vbCrLf & vbCrLf _
& "Rationale: " & rs!Rationale & vbCrLf & vbCrLf _
& "Notes: " & rs!Notes & vbCrLf _
& "Action Items: " & rs!ActionItems & vbCrLf _
& "__________________________________________________________________________" & vbCrLf & vbCrLf
End If
Next
rs.MoveNext
Loop
With objOutlookMsg
.Subject = NIE & " - " & Label & " " & StrWhere2 & " - " & Tod
.Body = StrHdrMail & strBdyMail & SigBlock
DoCmd.OutputTo 3, "rptOOB", acFormatPDF, "C:\Temp\" & NIE & " - " & Label & " " & StrWhere2 & " - " & Tod & ".pdf", , 0
.Attachments.Add ("C:\Temp\" & NIE & " - " & Label & " " & StrWhere2 & " - " & Tod & ".pdf")
.To = ""
.Display
Kill "C:\Temp\" & NIE & " - " & Label & " " & StrWhere2 & " - " & Tod & ".pdf"
DoCmd.Close acForm, "frmOOBChangeSelect"
DoCmd.Close acReport, "rptOOB"
DoCmd.OpenForm "frmStart"
End With
End If 'IsNull(Me.OOBNumber)
End If 'ctl.ItemsSelected.Count = 0
End If ' rs.movefirst & last
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