Page 2 of 2 FirstFirst 12
Results 16 to 24 of 24
  1. #16
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Now I get all the records in the email body.
    Maybe I missed it, but what is the SQL for "qRecSourceOOBChanges"? The recordset ("qRecSourceOOBChanges") should be limited to the selected items in the list box "SelectedOOBNumber".

    After this code executes
    Code:
            For Each varItem In ctl.ItemsSelected
                StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
                StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
    
                StrWhere = Left(StrWhere, Len(StrWhere) - 1)
                StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
            Next varItem
    what are the values for "StrWhere" and "StrWhere"?
    Please post the values.

  2. #17
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Steve,
    The code for qRecSourceOOBChange is:
    Code:
    SELECT [CRNo]+([SubNo]*0.01) AS OOBNumber, TblChangeRequest.Priority, TblChangeRequest.CRID, TblChangeRequest.[Level], TblChangeRequest.NIE, TblChangeRequest.ChangeType, TblChangeRequest.DateID, TblChangeRequest.ChangeRequested, TblChangeRequest.Rationale, TblChangeRequest.AOVote, TblChangeRequest.O6Vote, TblChangeRequest.Notes, TblChangeRequest.ActionItems, TblChangeRequest.Hr, TblChangeRequest.ActionComplete, Format([DateID],'dd mmmm yyyy') AS Dates, Format(Now()+([Hr]/24),'hhnn dddd", "mmm d yyyy') AS [Time], Format(Now()+([Hr]/24),'hhnn dddd", "mmm d yyyy') AS DTG, [Unit] & Chr(13) & Chr(10) & [Section] AS Units, [HBVersion] & Chr(13) & Chr(10) & [ApproxPage] AS HBVers, [MTOEPara] & Chr(13) & Chr(10) & [BumperNum] AS MTOEParas, [Requestor] & Chr(13) & Chr(10) & [Sponsor] AS People, DateDiff('d',[DateID],[DateClosed]) AS DaysOpen, [Priority] & ' ' & [Level] & ' OOB Change Request(s)' AS Label, Chr(9) & Chr(9) & [Unit] & Chr(9) & Chr(9) & [Section] AS Unitss, [HBVersion] & Chr(9) & Chr(9) & [ApproxPage] AS HBVerss, [MTOEPara] & Chr(9) & Chr(9) & [BumperNum] AS MTOEParass
    FROM TblChangeRequest
    WHERE (((TblChangeRequest.[ActionComplete])=False) AND ((TblChangeRequest.[AOVote])<>'Open') AND ((TblChangeRequest.[O6Vote]) Is Null) AND ((TblChangeRequest.[CRNo])<>0));
    It derives from:
    Code:
    Option Compare Database
    Option Explicit
    Sub subCreateQuery(arg)
        Dim sSQL As String
        Select Case arg
            Case 1
                sSQL = "SELECT [CRNo]+([SubNo]*0.01) AS OOBNumber,Priority, CRID, [Level], NIE, ChangeType, DateID, " _
                & "ChangeRequested, Rationale, AOVote, O6Vote, Notes, ActionItems, Hr, ActionComplete," _
                & "Format([DateID],'dd mmmm yyyy') AS Dates, " _
                & "Format(Now()+([Hr]/24),'hhnn dddd, mmm d yyyy') AS [Time], " _
                & "Format(Now()+([Hr]/24),'hhnn dddd, mmm d yyyy') AS DTG, [Unit] & Chr(13) & Chr(10) & " _
                & "[Section] AS Units, [HBVersion] & Chr(13) & Chr(10) & [ApproxPage] AS HBVers, " _
                & "[MTOEPara] & Chr(13) & Chr(10) & [BumperNum] AS MTOEParas, " _
                & "[Requestor] & Chr(13) & Chr(10) & [Sponsor] AS People, " _
                & "DateDiff('d',[DateID],[DateClosed]) AS DaysOpen, [Priority] & ' ' & [Level] & ' OOB Change Request(s)' AS Label, " _
                & "Chr(9) & Chr(9) & [Unit] & Chr(9) & Chr(9) & [Section] AS Unitss, [HBVersion] & Chr(9) & Chr(9) & [ApproxPage] AS HBVerss, " _
                & "[MTOEPara] & Chr(9) & Chr(9) & [BumperNum] AS MTOEParass " _
                & "FROM TblChangeRequest " _
                & "WHERE (([ActionComplete])= False) AND (([AOVote])" & TempVars!AOSelects & " AND (O6Vote) " & TempVars!O6Selects & " and (([CRNo])<>0));"
    
                Call fcnCustomizeSQL("qRecSourceOOBChanges", sSQL)
            
            Case 2
            Case 3
        End Select
    End Sub
    Function fcnCustomizeSQL(qName As String, strPassedSQL As String) As Boolean
        Dim qthisQuery As DAO.QueryDef
        If TempVars!tvEnableErrorHandling = True Then On Error GoTo fcnCustomizeSQL_Error   'if the query has been deleted, create it
        If DCount("Name", "MSysObjects", "[Name] = " & Chr$(39) & qName & Chr$(39)) = 0 Then
            Set qthisQuery = CurrentDb.CreateQueryDef(qName, strPassedSQL)
            Set qthisQuery = Nothing
            Exit Function
        End If
    
        Set qthisQuery = CurrentDb.QueryDefs(qName)
        qthisQuery.SQL = strPassedSQL
    fcnCustomizeSQL_Exit:
        On Error Resume Next
        Set qthisQuery = Nothing
        Exit Function
    fcnCustomizeSQL_Error:
        MsgBox Err.Number & ", " & Err.Description & ", fcnCustomizeSQL"
        Resume fcnCustomizeSQL_Exit
    End Function
    Strwhere & StrWghere2 comes from
    StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"

    this is the number that equates to the OOBNumber in the query.

    Set ctl = Me.SelectedOOBNumber
    Me.SelectedOOBNumber = unbound control list from frmOOBChangeSelect

  3. #18
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Quote Originally Posted by Thompyt View Post
    Strwhere & StrWghere2 comes from
    StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
    Not what I was looking for. I can see HOW the value is derived, it is the VALUE I was looking for.
    something like:
    strWHERE = '32','32.02'
    strWHERE2 = 32, 32.02

    Anyway....

    I am suspect of your SQL. I have never seen SQL code like:
    Code:
     & "[Requestor] & Chr(13) & Chr(10) & [Sponsor] AS People, " _
     & "DateDiff('d',[DateID],[DateClosed]) AS DaysOpen, [Priority] & ' ' & [Level] & ' OOB Change Request(s)' AS Label, " _
     & "Chr(9) & Chr(9) & [Unit] & Chr(9) & Chr(9) & [Section] AS Unitss, [HBVersion] & Chr(9) & Chr(9) & [ApproxPage] AS HBVerss, " _

    More changes......
    I found an error in the code (in red)and added lines (in blue) to limit the email body to the records that match the OOBNumber(s) selected in the list box.
    Code:
    Option Compare Database   '<<--should be at the top of EVERY MODULE
    Option Explicit                    '<<--should be at the top of EVERY MODULE
    
    Public Sub SelectedOOBChanges_Click()
        On Error GoTo Broke
    
        Dim objOutlook As Outlook.Application
        Dim objOutlookMsg As Outlook.MailItem, objOutlookMsg As Outlook.MailItem
        Dim objOutlookAttach As Outlook.Attachment
        Dim objOutlookRecip As Outlook.Recipient
        Dim ctl As Control, varItem As Variant, StrWhere As String, StrWhere2 As String, StrHdrMail As String, strBdyMail As String, I As Integer
        Dim rs As DAO.Recordset
    
        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
            'ItemsSelected.Count > 0
    
            DoCmd.RunCommand acCmdSaveRecord
    
            For Each varItem In ctl.ItemsSelected
                StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
                StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
            Next varItem
    
            StrWhere = Left(StrWhere, Len(StrWhere) - 1)       '<--moved this line outside of the For.. Next loop
            StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)  '<--moved this line outside of the For.. Next loop
    
            'open recordset
            Set rs = CurrentDb.OpenRecordset(qRecSourceOOBChanges)
            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
    
                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"
                    '            Exit Sub
                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
    
                    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       's.BOF And rs.EOF
        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
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Steve,
    The blue was exactly what I was looking for. It only displays whats selected in the email body. The use of the tabs in the query seems to work fine for me. It pushes the format I need to have on the reports and in the email. The base table stays without tabs. I thought it was just a format and wouldn't really affect the data. This query is only designed for that report/email instance. I did come up with an issue:

    I lose Priority and HR when the email generates. I thought putting DoCmd.RunCommand acCmdSaveRecord in the
    For Each varItem In ctl.ItemsSelected
    Next varItem
    Would update the HR and Priority fields in the base table. It only saves it for the first record available in the query. Is there a way to have it save HR and Priority in the selected records.

  5. #20
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Thanks Steve Much appreciated. The blue code is what I was looking for. The tabs in the query doesn't seem to slow anything down and formats the data where I need it to be. This query is a specific on for that report and email output. I also use the same format in other queries. I couldn't think of a way to have this forma implemented automatically. In other queries I have that in the Field name - People: [Requestor] & Chr(13) & Chr(10) & [Sponsor] so on and so forth.

    I am trying to update the main table with the Hr and Priority controls. The way I have it set up now it will save it to the first recordset only. It works fine for the header email, but will show a blank in the body email. Is there a way to save it to only the selected records? I tried to use your:
    For Each varItem In ctl.ItemsSelected
    If rs!OOBNumber = CDbl(ctl.ItemData(varItem)) Then.... but it will not save.

  6. #21
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 8 Access 2013
    Join Date
    Aug 2013
    Posts
    7,862
    What is this thread about? I thought it was about not using DAO on a listbox control?

  7. #22
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Quote Originally Posted by ItsMe View Post
    What is this thread about? I thought it was about not using DAO on a listbox control?
    It started that way. I was originally using a DAO, but couldn't get it to work right - until Steve squared it away. The plus side is I learned something and another codename CDbl.

  8. #23
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 8 Access 2013
    Join Date
    Aug 2013
    Posts
    7,862
    That is a built in function. There are many Conversion functions offered for Access. Also, VBA will automatically Cast down and up when it can.

    But, what I was getting at earlier is this thread seems to have gone down many different roads. Perhaps isolating one or two questions and starting a thread or two for those questions would be beneficial to many, including future users searching the forum.

  9. #24
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    rgr rgr WILCO

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

Similar Threads

  1. Replies: 6
    Last Post: 07-30-2015, 05:36 PM
  2. Replies: 1
    Last Post: 05-13-2015, 02:17 AM
  3. Replies: 7
    Last Post: 12-12-2014, 11:58 AM
  4. Team Db - Multiple Scores Per Athlete Over Multiple Meets...
    By rattler418 in forum Database Design
    Replies: 7
    Last Post: 12-01-2012, 02:36 AM
  5. Replies: 5
    Last Post: 08-02-2012, 09:44 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