Page 1 of 2 12 LastLast
Results 1 to 15 of 24
  1. #1
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839

    .EOF where it meets criteria

    How do I go about doing a While Not re.EOF rs.MoveNext Wend where there is a criteria.

    I don't want every record in the file.

    For Each varItem In ctl.ItemsSelected
    StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
    StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
    DoCmd.RunCommand acCmdSaveRecord

    Next varItem
    StrWhere = Left(StrWhere, Len(StrWhere) - 1)
    StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)

    The output is what I want to use only from the above



    I need to use an if OOB= strwhere then

    Code

    rst move.next

    Else

    Wend

    ?

    Am I off base?

    Thanks

  2. #2
    rpeare is offline VIP
    Windows XP Access 2003
    Join Date
    Jul 2011
    Posts
    5,442
    I have no idea what you're asking.

    Are you cycling through a recordset or cycling through a listbox? the code looks like you're cycling through a listbox but you don't use .movenext to cycle through items in a list box, you would use something like

    Code:
    with me.listboxname
        for i = 0 to .listcount -1
            if .selected = true then
                debug.print .column(1,i)
            endif
        next i
    end with

  3. #3
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 8 Access 2013
    Join Date
    Aug 2013
    Posts
    7,862
    Without getting too far into the whole EOF thing, it seems you are working with a Listbox Control. So you are iterating a collection of objects that are not DAO.Recordsets. IIRC you can store each iteration in an array and look at each element within the Array. For instance, you have a multicolumn listbox that is multiselect. You can grab one of the selections and look at each of the columns.

  4. #4
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Here is code to:
    Use a multi-select list box to filter a report
    http://www.allenbrowne.com/ser-50.html


    maybe it will help....

  5. #5
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Thanks ssanfu
    you probably recognize the code already.

  6. #6
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    I think I may need assistance in the for - - next. I am looking to have only the selected records show up in the strBdyMail. I either get none, or I get three sets of duplicates. I am having difficulties posting this at work.

    Code:
    On Error GoTo Error
      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
      
    Set objOutlook = CreateObject("Outlook.Application")
      Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
      Set rst = CurrentDb.OpenRecordset("SELECT OOBNumber FROM qRecSourceOOBChanges ORDER BY [Level], CRID ASC")
      Set ctl = Me.SelectedOOBNumber
       
    If Me.SelectedOOBNumber.ItemsSelected.Count = 0 Then
         MsgBox "Nothing was selected"
            Exit Sub
        End If
     
    For Each varItem In ctl.ItemsSelected
     
       StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
       StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
     
    Next varItem
       StrWhere = Left(StrWhere, Len(StrWhere) - 1)
       StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
      
       Me.OOBChanges = StrWhere2
     
    DoCmd.RunCommand acCmdSaveRecord
     
        If IsNull(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
        End If
     
    DoCmd.OpenReport "rptOOB", acViewReport, , "OOBNumber IN(" & StrWhere & ")"
     
    StrHdrMail = "This is a follow-on action from the AORB/CCB/TEWG discussion on CR(S)" & OOBChanges & ". If needed, please back-brief your higher for SA, " _   ' Works as needed
                 & "and let us know if there are any issues or concerns. The Change Request priority is " & Priority & " with " & Hr & " hours until " _
                 & "CR(S)" & OOBChanges & " is automatically approved (GO OOB Excepted). Please provide your votes NLT " & DTG & "." & vbCrLf & vbCrLf
     
    With ctl
     
    For I = 0 To .ListCount - 1
     
    MsgBox I  'I have three possible records, I watch the count go from 0 to 2
     
    If ctl = Me.SelectedOOBNumber Then' there is no output from this part - Probably from ctl is null?  I tried if Not isnull(StrWhere) then - I get three repeated records.
     
    strBdyMail = strBdyMail & "Date Issue Identified:" & Chr(9) & Chr(9) & Dates & Chr(9) & Chr(9) & "Days Open:" & Chr(9) & DaysOpen & vbCrLf _
                 & "Priority: " & Chr(9) & Chr(9) & Chr(9) & Priority & vbCrLf _
                 & "CR Number: " & Chr(9) & Chr(9) & Chr(9) & OOBNumber & vbCrLf & vbCrLf _
                 & "AO Recommendation: " & Chr(9) & Chr(9) & AOVote & vbCrLf _
                 & "O6 Recommendation: " & Chr(9) & Chr(9) & O6Vote & vbCrLf & vbCrLf _
                 & "Change Requested: " & Chr(9) & Chr(9) & [ChangeRequested] & vbCrLf & vbCrLf _
                 & "Unit & Section: " & Chr(9) & Unitss & vbCrLf _
                 & "MTOE Para & Bumper: " & Chr(9) & Chr(9) & [MTOEParass] & vbCrLf & vbCrLf _
                 & "Rationale: " & Rationale & vbCrLf & vbCrLf _
                 & "Notes: " & Notes & vbCrLf _
                 & "Action Items: " & ActionItems & vbCrLf _
                 & "__________________________________________________________________________" & vbCrLf & vbCrLf
     
    End If
     Next I
     End With

  7. #7
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    This does not look right - If ctl = Me.SelectedOOBNumber. ctl is an object with several properties, depending on what it has been set to and I doubt there is a default property for such a user defined object, even if Access figures out what the object is. I'd write it as
    If ctl.value = Me.SelectedOOBNumber; however, if this is a listbox as I suspect, it does not have a 'value' property so your result will be Null. Test this in the vb editor when the form is open by querying in the immediate window: ?forms!frmYourFormName.YourListboxName and hit return. You should see Null as a result; this is how you test assumptions about the values of controls or variables (or use debug.print statements while troubleshooting). You either need to retrieve the item via like Me.lstBox.Selected(Index number here) or iterate through its collection. What you ARE saying with If ctl = Me.SelectedOOBNumber is, if the object I declared (ctl) is Me.SelectedOOBNumber Then,
    but of course it is if you SET it to be that already... and it is null.

    For the reason already given, this looks problematic as well -
    If IsNull(OOBNumber) Then
    Last edited by Micron; 09-12-2016 at 09:21 PM. Reason: clarification
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  8. #8
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    These are my thoughts on the code.
    Just showing the errors I see:
    Code:
        On Error GoTo Error
    'You can use 
    'On Error GoTo Bananas
    'On Error Goto Titanic '(as in you're sunk)
    'On Error Goto Error_Handler
    
    'You should not use 
    'On Error GoTo Error    'yes, "Error" is a label, but it can get confusing......
    
    
          Set rst = CurrentDb.OpenRecordset("SELECT OOBNumber FROM qRecSourceOOBChanges ORDER BY [Level], CRID ASC")
           'Why open a recordset? you don't use it. You don't close it. You don't set it to nothing
    
        Set ctl = Me.SelectedOOBNumber
    
        If Me.SelectedOOBNumber.ItemsSelected.Count = 0 Then
         'Why use "Me.SelectedOOBNumber."??? In the line above, you just set ctl = Me.SelectedOOBNumber.
    
        'you should use
        If ctl.ItemsSelected.Count = 0 Then
           .
           .
        End If
    
    
    
        If IsNull(OOBNumber) Then
         'What is  "OOBNumber"??? It is not a declared variable. If it is a control on a form, it would be better to use "Me.OOBNumber"..
    
        ' Else  < not needed
        
        End If
    
    
        With ctl  'ctl = Me.SelectedOOBNumber .  see above
    
            For I = 0 To .ListCount - 1
    
                MsgBox I  'I have three possible records, I watch the count go from 0 to 2
    
                If ctl = Me.SelectedOOBNumber Then    '<<-- this doesn't make sense
                 ' You already set ctl = Me.SelectedOOBNumber in a line above. What is accomplished using this comparison??
    
    
                    ' Again, if you are referring to a control on a form, it would be better to use "Me." in front of the control name..
                    strBdyMail = strBdyMail & "Date Issue Identified:" & Chr(9) & Chr(9) & Dates & Chr(9) & Chr(9) & "Days Open:" & Chr(9) & DaysOpen & vbCrLf _
                                 & "Priority: " & Chr(9) & Chr(9) & Chr(9) & Priority & vbCrLf _
                                 & "CR Number: " & Chr(9) & Chr(9) & Chr(9) & OOBNumber & vbCrLf & vbCrLf _
                                 & "AO Recommendation: " & Chr(9) & Chr(9) & AOVote & vbCrLf _
                                 & "O6 Recommendation: " & Chr(9) & Chr(9) & O6Vote & vbCrLf & vbCrLf _
                                 & "Change Requested: " & Chr(9) & Chr(9) & [ChangeRequested] & vbCrLf & vbCrLf _
                                 & "Unit & Section: " & Chr(9) & Unitss & vbCrLf _
                                 & "MTOE Para & Bumper: " & Chr(9) & Chr(9) & [MTOEParass] & vbCrLf & vbCrLf _
                                 & "Rationale: " & Rationale & vbCrLf & vbCrLf _
                                 & "Notes: " & Notes & vbCrLf _
                                 & "Action Items: " & ActionItems & vbCrLf _
                                 & "__________________________________________________________________________" & vbCrLf & vbCrLf
    
                End If
            Next I
        End With

    Not real sure what you are trying to do with this code.

    Are you trying to send 3 emails?
    Maybe that is what the records set was for - to get the data??

    If you want to loop through the multi select list box, you will need to use "For Each" code like the section for StrWhere & StrWhere2

  9. #9
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Thanks Steve for digging through and the comments - Still a learning puppy here. Some of it was left over from other tries to make it work.

    I used your suggestions and got it to work almost. It will set up the pdf report perfectly, mirrors what I selected in the list box. The StrBdyMail will mirror the amount I selected, but if there are more than 1 items selected all will show the first record. Also I noted, it always uses the first record no matter what is selected. If I select the second item it pulls the data from the first record. I am only able to save the first record changes to update the Priority and HR controls.

    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"
            Exit Sub
        End If
    
    For Each varItem In ctl.ItemsSelected
       StrWhere = StrWhere & "'" & ctl.ItemData(varItem) & "',"
       StrWhere2 = StrWhere2 & " " & ctl.ItemData(varItem) & ","
      
    DoCmd.RunCommand acCmdSaveRecord
      
    strBdyMail = strBdyMail & "Date Issue Identified:" & Chr(9) & Chr(9) & Dates & Chr(9) & Chr(9) & "Days Open:" & Chr(9) & DaysOpen & vbCrLf _
                 & "Priority: " & Chr(9) & Chr(9) & Chr(9) & Priority & vbCrLf _
                 & "CR Number: " & Chr(9) & Chr(9) & Chr(9) & OOBNumber & vbCrLf & vbCrLf _
                 & "AO Recommendation: " & Chr(9) & Chr(9) & AOVote & vbCrLf _
                 & "O6 Recommendation: " & Chr(9) & Chr(9) & O6Vote & vbCrLf & vbCrLf _
                 & "Change Requested: " & Chr(9) & Chr(9) & [ChangeRequested] & vbCrLf & vbCrLf _
                 & "Unit & Section: " & Chr(9) & Unitss & vbCrLf _
                 & "MTOE Para & Bumper: " & Chr(9) & Chr(9) & [MTOEParass] & vbCrLf & vbCrLf _
                 & "Rationale: " & Rationale & vbCrLf & vbCrLf _
                 & "Notes: " & Notes & vbCrLf _
                 & "Action Items: " & ActionItems & vbCrLf _
                 & "__________________________________________________________________________" & vbCrLf & vbCrLf
      
    Next varItem
       StrWhere = Left(StrWhere, Len(StrWhere) - 1)
       StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
     
        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
        End If
     
    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
     
     Set ctl = Nothing
     Set rst = Nothing
     Set objOutlookMsg = Nothing
     Set objOutlook = Nothing
     Set objOutlookAttach = 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
    End Sub

  10. #10
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Lets go back a little.

    Please explain what you want to do, not how you are doing it.


    You have a form. On the form is a multi-select list box. Lets say there are 6 items selected in the list box: 1, 3 & 6.

    You want to include data from (??) in the email body (strBdyMail)? All 3 select items in the list box?

    Q: Why are you using strWhere and strWhere2? Since they will have identical values, why not just have strWhere??

    Q: What are "NIE" and "Tod"? Controls on the form? Variables?


    Q:Where do the values for "Dates", DaysOpen", "Priority", "OOBNumber", "AOVote", ... come from?
    Code:
                strBdyMail = strBdyMail & "Date Issue Identified:" & Chr(9) & Chr(9) & Dates & Chr(9) & Chr(9) & "Days Open:" & Chr(9) & DaysOpen & vbCrLf _
                             & "Priority: " & Chr(9) & Chr(9) & Chr(9) & Priority & vbCrLf _
                             & "CR Number: " & Chr(9) & Chr(9) & Chr(9) & OOBNumber & vbCrLf & vbCrLf _
                             & "AO Recommendation: " & Chr(9) & Chr(9) & AOVote & vbCrLf _
                             & "O6 Recommendation: " & Chr(9) & Chr(9) & O6Vote & vbCrLf & vbCrLf _
                             & "Change Requested: " & Chr(9) & Chr(9) & [ChangeRequested] & vbCrLf & vbCrLf _
                             & "Unit & Section: " & Chr(9) & Unitss & vbCrLf _
                             & "MTOE Para & Bumper: " & Chr(9) & Chr(9) & [MTOEParass] & vbCrLf & vbCrLf _
                             & "Rationale: " & Rationale & vbCrLf & vbCrLf _
                             & "Notes: " & Notes & vbCrLf _
                             & "Action Items: " & ActionItems & vbCrLf _

  11. #11
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    You have a form. On the form is a multi-select list box. Lets say there are 6 items selected in the list box: 1, 3 & 6. - Correct assumption

    Initiating form:

    Code:
    Private Sub AOOOB_Click()
    
    Me.AOSelects = " <> 'Defer' And (AOVote) <> 'Hold' and (AOVote) <> 'Deny'" 'and (AOVote) <> 'Approve'
    Me.O6Selects = ""
    
        TempVars!AOSelects = Me.AOSelects.Value
        TempVars!O6Selects = Me.O6Selects.Value
        Call subCreateQuery(1)
    
        DoCmd.OpenForm "frmOOBChangeSelect"
    
    End Sub
    Private Sub CCBOOB_Click()
    
    Me.AOSelects = " <> 'Open'"
    Me.O6Selects = " is Null"
    
        TempVars!AOSelects = Me.AOSelects.Value
        TempVars!O6Selects = Me.O6Selects.Value
        
        Call subCreateQuery(1)
    
        DoCmd.OpenForm "frmOOBChangeSelect"
    End Sub
    Private Sub GOOOB_click()
    
    Me.AOSelects = "<> 'Open'"
    Me.O6Selects = " <> 'Defer' and (O6Vote) <> 'Hold'"
    
        TempVars!AOSelects = Me.AOSelects.Value
        TempVars!O6Selects = Me.O6Selects.Value
        Call subCreateQuery(1)
        
        DoCmd.OpenForm "frmOOBChangeSelect"
        
    End Sub
    You want to include data from (??) in the email body (strBdyMail)? All 3 select items in the list box?

    A: If you have selected the three items (1, 3 & 6) that is correct.

    Q: Why are you using strWhere and strWhere2? Since they will have identical values, why not just have strWhere??

    A: I am using StrWhere for the report, and strwhere2 for the email in the subject body and file naming conventions. Unless there is another way to get rid of the ' marks around the numbers from strwhere.

    Q: What are "NIE" and "Tod"? Controls on the form? Variables?

    NIE is a control that's automatically generated on the main table and picked up by the query in the Query module. TOD is today's date formatted in a module

    TOD:
    Code:
    Option Explicit
    Function Tod() As String
     Tod = Format(Date, "dd mmm yyyy")
    End Function
    Q:Where do the values for "Dates", DaysOpen", "Priority", "OOBNumber", "AOVote", ... come from?

    A: These come from a module that makes a query from the main table - It filters all the data down to the records that meet the criteria when one of three buttons are selected.

    Query Module:
    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

  12. #12
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Still really fuzzy about your process. (and not because of )

    Not sure which are controls, variables, temp variables or global variables.

    I massaged this some... well more than a little.
    Look it over closely and single step through it .....
    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) & ","
    
                StrWhere = Left(StrWhere, Len(StrWhere) - 1)
                StrWhere2 = Left(StrWhere2, Len(StrWhere2) - 1)
            Next varItem
    
            '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
                    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
    
                    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

    I must admit I've never seen queries with tabs embedded in the SQL. I'll have to try it....

  13. #13
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Edit,
    Thanks Steve!

    Its closer to whats intended. I was using the DAO.Recordset previously but couldn't get it to see the data in it with the Looped portion of the email. Now I get all the data in the body even when I select 1 record.

    This helps a lot right here - rs! - I did not know that i needed to add this to direct it to the query - doa recordset. Thanks


    why do you need this?

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

  14. #14
    ssanfu is offline Master of Nothing
    Windows XP Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    If you open a record set that returns 0 records and you try to refer to a field, the code will bomb. It is a check to ensure there are records returned.
    If 0 records are returned, I close the recordset.

    The rs.MoveLast: fully populates the record set. Necessary if you want to check the number of records returned.
    rs.MoveFirst obviously moves back to the first record of the record set.

  15. #15
    Thompyt is offline Expert
    Windows 8 Access 2010 32bit
    Join Date
    Sep 2014
    Location
    El Paso, TX
    Posts
    839
    Steve,
    Thanks again.

    Now I get all the records in the email body. That's a good step further than getting duplicate entries equal to the number of records. How do I get it to reference the selection so that it puts only the info for the selected row(s)?

    DoCmd.OpenReport "rptOOB", acViewReport, , "OOBNumber IN(" & StrWhere & ")" puts it in the report, so I am assuming StrWhere is the key.

Page 1 of 2 12 LastLast
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