Page 2 of 2 FirstFirst 12
Results 16 to 21 of 21
  1. #16
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    Please answer questions when I pose them - so I have a better understanding of what needs to be done.


    One more: is the priority supposed to be saved to the table or just passed to the report/email?
    Gotta run now...

  2. #17
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Both.
    The PDF report attachment has code looking to the main table to set up a title banner. The email header uses it as all the selected should have the same priority and HR. The email subject uses Priority and HR, The naming convention of the report uses Priority and HR, and the Email Body Text uses Priority in each selected CR.

    Saving it in the main table also allows a way to track what was an OOB item throughout the exercise at a later date.

  3. #18
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    I modified the code to update the fields "Priority" and "Hr" in table "tblChangeRequest".

    For the code to work, you MUST change the name of the "Priority" combo box to "cboPrty" and the name of the "Hours" comb box to "cboHrs".
    (blue & green lines are the lines I added)
    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) & ","
    
                'now update tblChangeRequest with Priority and Hr
                'have to split SelectedOOBNumber back into CRNO and SubNo
                'CRNO
                dCRNO = Int(ctl.ItemData(varItem))
                'SubNo
                sngSubNo = (ctl.ItemData(varItem) - Int(ctl.ItemData(varItem))) * 100
    
                ' update
                sSQL = "UPDATE tblChangeRequest SET tblChangeRequest.Priority = '" & Me.cboPrty & "', tblChangeRequest.Hr = " & Me.cboHrs
                sSQL = sSQL & " WHERE (((tblChangeRequest.CRNo)=" & dCRNO & ") AND ((tblChangeRequest.SubNo)=" & sngSubNo & "));"
                '            Debug.Print sSQL
                CurrentDb.Execute sSQL
    
            Next varItem
    
            'remove the last comma
            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
    
                                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   'If rs.BOF And rs.EOF Then
            End If      'IsNull(Me.OOBNumber)
        End If          'ctl.ItemsSelected.Count = 0
    
    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

  4. #19
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    Some notes that you may find repeated as comments in my code version. Format: your code > my comment.

    Set rs = CurrentDb.OpenRecordset("qRecSourceOOBChanges") > there is already a useable recordset belonging to the form.

    If IsNull(Me.OOBNumber) Then > if there is anything in the listbox at all, this will never be null. If there is nothing in the listbox, the first check on this that I added will cause the procedure to exit.

    If rs.BOF And rs.EOF Then > this recordset is the same as the one that the form is predicated on, which is also the same source as the listbox, so there no need to check this condition since if it is true, there was nothing in the listbox to select in the first place.

    Do While Not rs.EOF > again, the recordset you create is based on the same as the form recordset, so there is no need to recreate what you already have. If the values are in the listbox, they are also part of the form's recordset. The count of listbox items and the count of form records would not only be the same, any given field would have the same value.

    Set objOutlookAttach > this is declared, but never set to anything

    It's not a great idea to declare all of your variables at the module level like you have done. If you add another procedure later and out of habit reuse one (e.g. sql as string) you can get wonky results.

    I closed the rs before setting to nothing
    You MIGHT want to change rs.Fields(#) to the actual name of the field. If you ever re-arrange the query field order in such a way that causes these fields to be out of sync, errors will occur.

    ****begin code, which seems to work for me****

    Code:
    Public Sub SelectedOOBChanges_Click()
    Dim sql As String
    
    On Error GoTo Broke
    
    Set rs = Me.Recordset 'form is based on a query - same one for the listbox and rs you were creating. Let's use that.
    If rs.RecordCount = 0 Then
        MsgBox "There are no OOB CRs."
        TempVars.RemoveAll
        Call subCreateQuery(1)
        DoCmd.Close acForm, "frmEmailAORB"
        DoCmd.OpenForm "frmStart"
    End If
    'not sure if the count is 0 that the previous should happen, then be followed by the rest of the code
    
    Set ctl = Me.SelectedOOBNumber 'if the above OK, then create the ctl object
    If ctl.ItemsSelected.Count = 0 Then
        MsgBox "Nothing was selected"
        Exit Sub
    End If
    
    'if there is at least 1 record and at least 1 listbox item selected, then create more objects
    Set objOutlook = CreateObject("Outlook.Application")
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
              
    rs.MoveFirst 'ensure we're at the first record of form recordset
    
    For Each varItem In ctl.ItemsSelected 'by your design, this count and the values are the same in the form and listbox
        If rs.Fields(0) = CDbl(ctl.ItemData(varItem)) Then
            sql = "UPDATE tblChangeRequest SET tblChangeRequest.Priority = '" & Me.Prty & "' WHERE [CRID] = " & rs.Fields(2)
            CurrentDb.Execute sql, dbFailOnError
            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
            
            StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
            StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
        End If
    rs.MoveNext
    Next varItem
                                
    StrWhere = Left(StrWhere, Len(StrWhere) - 1)
    StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
    
    'why open this report if no one gets a chance to look at it?
    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
      
    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
    
    Broke_Exit:
    On Error Resume Next
    
    Set ctl = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
    Set objOutlookAttach = Nothing 'this is never set, so why set to nothing?
    rs.Close
    Set rs = Nothing
    Exit Sub
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  5. #20
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Micron I run the following and it fails on DoCmd.OutputTo 3, "rptOOB", acFormatPDF, "C:\Temp" & NIE & " - " & Label & " " & StrWhere2 & " - " & Tod & ".pdf", , 0

    Runtime Error code 2501. No records? if I put ' before it and the .attach, then the Email text and subject are fine.

    Code:
    Public Sub SelectedOOBChanges_Click()
    
    Dim sql As String
    
    'On Error GoTo Broke
    
    Set rs = Me.Recordset
    If rs.RecordCount = 0 Then
        MsgBox "There are no OOB CRs."
        TempVars.RemoveAll
        Call subCreateQuery(1)
        DoCmd.Close acForm, "frmEmailAORB"
        DoCmd.OpenForm "frmStart"
    End If
    
    Set ctl = Me.SelectedOOBNumber
    If ctl.ItemsSelected.Count = 0 Then
        MsgBox "Nothing was selected"
        Exit Sub
    End If
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
              
    rs.MoveFirst
    
    For Each varItem In ctl.ItemsSelected
        If rs.Fields(0) = CDbl(ctl.ItemData(varItem)) Then
            sql = "UPDATE tblChangeRequest SET tblChangeRequest.Priority = '" & Me.cboPrty & "' WHERE [CRID] = " & rs.Fields(2)
            CurrentDb.Execute sql, dbFailOnError
            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
            
            StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
            StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
    
        End If
    rs.MoveNext
    
    Next varItem
                                
    StrWhere = Left(StrWhere, Len(StrWhere) - 1)
    StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
    
    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
      
    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
    
    Broke_Exit:
        On Error Resume Next
    
        Set ctl = Nothing
        Set objOutlookMsg = Nothing
        Set objOutlook = 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:
    Exit Sub
    
    End Sub

  6. #21
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    The message means the open report action was cancelled. Not sure if I placed that line there in error with all the code pieces I moved around, or if you had it there. I suspect the former. The With block is one that you can do a bunch of stuff with on an object, and generally I don't include any code that doesn't relate to that object, so I'd say to open a report within a With block for an Outlook message is verboten. Try moving that line just before the With block code for the Outlook message.

    I couldn't test it fully since I didn't have a similar path where you're creating a pdf.

Page 2 of 2 FirstFirst 12
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Updating records based on another table
    By bondalisha in forum Access
    Replies: 2
    Last Post: 11-19-2015, 12:45 PM
  2. Replies: 3
    Last Post: 10-08-2015, 01:02 PM
  3. updating records to another table.
    By sankar519 in forum Access
    Replies: 1
    Last Post: 06-30-2014, 08:31 AM
  4. Updating main table from temp table AND form value
    By shabbaranks in forum Programming
    Replies: 8
    Last Post: 05-01-2013, 07:18 AM
  5. Replies: 3
    Last Post: 11-04-2012, 09:25 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums