Include Multiple Records in Email

[gopherking]

I have been trying to figure out a way to include multiple records in a single email that would be sent for each request# we have. Basically, a Request can have more than one entry and I am trying to create an all inclusive email with each record for that request to be sent out as a whole. Currently, I can generate a single email for each entry, but that may mean that 3 or more emails could be sent for the same Request #.



I have tried to use a recordset and the .FindFirst, .FindNext options to hopefully cycle through all entries (I am currently assuming no more than 3 would appear) and updates a predefined string (strbodytext1, strbodytext2, strbodytext3) and if .EOF or .NoMatch are encountered then it simply creates the email. When the email is created, it includes all the strBodyText strings into one and prints them into the email.

Now, I was able to get it to print 3 lines for the 3 strbodyText strings, however they were the exact same lines, and I know the Request in question has 2 entries with different information in them.

Any ideas that I can use to cycle through the records and include them in the email as separate lines?

[boblarson]

Post the code you currently have for the single record and we'll help modify it to what it needs to be for multiples.

[gopherking]

Here is the code as I left it last which results in 3 of the same records being posted for the Request ID in question:

Private Sub ConfirmHrsEmail_Btn_Click()
On Error GoTo ErrorHandler
    Dim strBodyText, strBodyText1, strBodyText2, strBodyText3 As String
    'Reference the Outlook Application
    Dim olAPP As Outlook.Application
    ' The NameSpace object allows you to reference folders
    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    'Create a reference to the email item you will use to send your email
    Dim olMailItem As Outlook.MailItem
    Dim db As Database
    Dim rec As DAO.Recordset
    
    'Create the Outlook object
    Set olAPP = CreateObject("Outlook.Application")
    Set olNS = olAPP.GetNameSpace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
    Set olMailItem = olFolder.Items.Add("IPM.Note")
    
    Set db = CurrentDb
    Set rec = db.OpenRecordset("DeliveredRequests_P2P_w/ActualHrs_Query")
        
    'Create the body of the message from teh data in the form
    strBodyText = "Please confirm the monthly scheduled hours shown below for RFC #" & Me.P2PRFC_ & " / " & _
        "Request #" & Me.P2PCapReqID & " are correct.  If they need to be adjusted, please respond back " & _
        "to this email and include any necessary adjustments to be made to record the accurate Actual " & _
        "Hours spent by month." _
        & vbCrLf & vbCrLf & "If you have any questions, please respond back to this email." & vbCrLf _
        & vbCrLf & "RFC#:  " & vbTab & vbTab & Me.P2PRFC_ _
        & vbCrLf & "Request ID#:  " & vbTab & Me.P2PCapReqID _
        & vbCrLf & "Delivered Year:  " & vbTab & Me.P2PActualPRODYear _
        & vbCrLf & "Delivered Month:  " & Me.P2PActualPRODMonth _
        & vbCrLf & "Release:  " & vbTab & vbTab & Me.P2PActualRelease _
        & vbCrLf & vbCrLf & "Year:" & vbTab & "Jan:" & vbTab & "Feb:" & vbTab & "Mar:" & vbTab & "Apr:" & vbTab _
        & "May:" & vbTab & "Jun:" & vbTab & "Jul:" & vbTab & "Aug:" & vbTab & "Sep:" & vbTab & "Oct:" _
        & vbTab & "Nov:" & vbTab & "Dec:" & vbCrLf
    With rec
        .MoveFirst
        If Not .NoMatch Or .EOF Then
        strBodyText1 = Me.CapacityP2PDevActYear & vbTab & Me.JANP2PDevAct _
            & vbTab & Me.FEBP2PDevAct & vbTab & Me.MARP2PDevAct & vbTab & Me.APRP2PDevAct & vbTab _
            & Me.MAYP2PDevAct & vbTab & Me.JUNP2PDevAct & vbTab & Me.JULP2PDevAct & vbTab & Me.AUGP2PDevAct _
            & vbTab & Me.SEPP2PDevAct & vbTab & Me.OCTP2PDevAct & vbTab & Me.NOVP2PDevAct & vbTab _
            & Me.DECP2PDevAct
        End If
        
        
        .MoveNext
        If Not .NoMatch Or .EOF Then
        strBodyText2 = Me.CapacityP2PDevActYear & vbTab & Me.JANP2PDevAct _
            & vbTab & Me.FEBP2PDevAct & vbTab & Me.MARP2PDevAct & vbTab & Me.APRP2PDevAct & vbTab _
            & Me.MAYP2PDevAct & vbTab & Me.JUNP2PDevAct & vbTab & Me.JULP2PDevAct & vbTab & Me.AUGP2PDevAct _
            & vbTab & Me.SEPP2PDevAct & vbTab & Me.OCTP2PDevAct & vbTab & Me.NOVP2PDevAct & vbTab _
            & Me.DECP2PDevAct
        End If
        
        .MoveNext
        If Not .NoMatch Or .EOF Then
        strBodyText3 = Me.CapacityP2PDevActYear & vbTab & Me.JANP2PDevAct _
            & vbTab & Me.FEBP2PDevAct & vbTab & Me.MARP2PDevAct & vbTab & Me.APRP2PDevAct & vbTab _
            & Me.MAYP2PDevAct & vbTab & Me.JUNP2PDevAct & vbTab & Me.JULP2PDevAct & vbTab & Me.AUGP2PDevAct _
            & vbTab & Me.SEPP2PDevAct & vbTab & Me.OCTP2PDevAct & vbTab & Me.NOVP2PDevAct & vbTab _
            & Me.DECP2PDevAct
        End If
    End With
    
    With olMailItem
        .BCC = Environ("username")
        .Subject = "Confirm Actual Development Hours for RFC #" & Me.P2PRFC_ & " / Enhancement Request #" & _
            Me.P2PCapReqID
        .BodyFormat = olFormatPlain
        .Body = strBodyText & vbCrLf & strBodyText1 & vbCrLf & strBodyText2 & vbCrLf & strBodyText3
        .Importance = olImportanceHigh
        .FlagStatus = olFlagMarked
        .FlagDueBy = Date + 2
        .Display
    End With
    
    Set olMailItem = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olAPP = Nothing
ExitHere:
    Exit Sub
ErrorHandler:
    Call UnexpectedError(Err.Number, Err.Description)
    Resume ExitHere
End Sub

Feel free to hack it up ... I'm game for anything right now ...

[gopherking]

OK, I guess I needed to sleep on it and have Bob awaken a dark part of my brain because I got it to work!!! Below is the code that I have adjusted to get this working as expected:

Private Sub ConfirmHrsEmail_Btn_Click()
On Error GoTo ErrorHandler
    Dim strBodyText, strBodyText1, strBodyText2, strBodyText3 As String
    'Reference the Outlook Application
    Dim olAPP As Outlook.Application
    ' The NameSpace object allows you to reference folders
    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    'Create a reference to the email item you will use to send your email
    Dim olMailItem As Outlook.MailItem
    Dim db As Database
    Dim rec As DAO.Recordset
    Dim ActYear, JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC
    
    'Create the Outlook object
    Set olAPP = CreateObject("Outlook.Application")
    Set olNS = olAPP.GetNameSpace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
    Set olMailItem = olFolder.Items.Add("IPM.Note")
    
    Set db = CurrentDb
    Set rec = db.OpenRecordset("DeliveredRequests_P2P_w/ActualHrs_Query")
        
    'Create the body of the message from teh data in the form
    strBodyText = "Please confirm the monthly scheduled hours shown below for RFC #" & Me.P2PRFC_ & " / " & _
        "Request #" & Me.P2PCapReqID & " are correct.  If they need to be adjusted, please respond back " & _
        "to this email and include any necessary adjustments to be made to record the accurate Actual " & _
        "Hours spent by month." _
        & vbCrLf & vbCrLf & "If you have any questions, please respond back to this email." & vbCrLf _
        & vbCrLf & "RFC#:  " & vbTab & vbTab & Me.P2PRFC_ _
        & vbCrLf & "Request ID#:  " & vbTab & Me.P2PCapReqID _
        & vbCrLf & "Delivered Year:  " & vbTab & Me.P2PActualPRODYear _
        & vbCrLf & "Delivered Month:  " & Me.P2PActualPRODMonth _
        & vbCrLf & "Release:  " & vbTab & vbTab & Me.P2PActualRelease _
        & vbCrLf & vbCrLf & "Year:" & vbTab & "Jan:" & vbTab & "Feb:" & vbTab & "Mar:" & vbTab & "Apr:" & vbTab _
        & "May:" & vbTab & "Jun:" & vbTab & "Jul:" & vbTab & "Aug:" & vbTab & "Sep:" & vbTab & "Oct:" _
        & vbTab & "Nov:" & vbTab & "Dec:" & vbCrLf
    With rec
        .MoveFirst
        If Not .NoMatch Or .EOF Then
        ActYear = !CapacityP2PDevActYear
        JAN = rec!JANP2PDevAct
        FEB = rec!FEBP2PDevAct
        MAR = rec!MARP2PDevAct
        APR = rec!APRP2PDevAct
        MAY = rec!MAYP2PDevAct
        JUN = rec!JUNP2PDevAct
        JUL = rec!JULP2PDevAct
        AUG = rec!AUGP2PDevAct
        SEP = rec!SEPP2PDevAct
        OCT = rec!OCTP2PDevAct
        NOV = rec!NOVP2PDevAct
        DEC = rec!DECP2PDevAct
        
        strBodyText1 = ActYear & vbTab & JAN & vbTab & FEB & vbTab & MAR & vbTab & APR & vbTab & MAY _
            & vbTab & JUN & vbTab & JUL & vbTab & AUG & vbTab & SEP & vbTab & OCT & vbTab & NOV _
            & vbTab & DEC
        End If
        
        
        .MoveNext
        If Not .NoMatch Or .EOF Then
        ActYear = !CapacityP2PDevActYear
        JAN = rec!JANP2PDevAct
        FEB = rec!FEBP2PDevAct
        MAR = rec!MARP2PDevAct
        APR = rec!APRP2PDevAct
        MAY = rec!MAYP2PDevAct
        JUN = rec!JUNP2PDevAct
        JUL = rec!JULP2PDevAct
        AUG = rec!AUGP2PDevAct
        SEP = rec!SEPP2PDevAct
        OCT = rec!OCTP2PDevAct
        NOV = rec!NOVP2PDevAct
        DEC = rec!DECP2PDevAct
        
        strBodyText2 = ActYear & vbTab & JAN & vbTab & FEB & vbTab & MAR & vbTab & APR & vbTab & MAY _
            & vbTab & JUN & vbTab & JUL & vbTab & AUG & vbTab & SEP & vbTab & OCT & vbTab & NOV _
            & vbTab & DEC
        End If
        
        .MoveNext
        If Not .NoMatch Or .EOF Then
        ActYear = !CapacityP2PDevActYear
        JAN = rec!JANP2PDevAct
        FEB = rec!FEBP2PDevAct
        MAR = rec!MARP2PDevAct
        APR = rec!APRP2PDevAct
        MAY = rec!MAYP2PDevAct
        JUN = rec!JUNP2PDevAct
        JUL = rec!JULP2PDevAct
        AUG = rec!AUGP2PDevAct
        SEP = rec!SEPP2PDevAct
        OCT = rec!OCTP2PDevAct
        NOV = rec!NOVP2PDevAct
        DEC = rec!DECP2PDevAct
        
        strBodyText3 = ActYear & vbTab & JAN & vbTab & FEB & vbTab & MAR & vbTab & APR & vbTab & MAY _
            & vbTab & JUN & vbTab & JUL & vbTab & AUG & vbTab & SEP & vbTab & OCT & vbTab & NOV _
            & vbTab & DEC
        End If
    End With
    
    With olMailItem
        .BCC = Environ("username")
        .Subject = "Confirm Actual Development Hours for RFC #" & Me.P2PRFC_ & " / Enhancement Request #" & _
            Me.P2PCapReqID
        .BodyFormat = olFormatPlain
        .Body = strBodyText & vbCrLf & strBodyText1 & vbCrLf & strBodyText2 & vbCrLf & strBodyText3
        .Importance = olImportanceHigh
        .FlagStatus = olFlagMarked
        .FlagDueBy = Date + 2
        .Display
    End With
    
    Set olMailItem = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olAPP = Nothing
ExitHere:
    Exit Sub
ErrorHandler:
    Call UnexpectedError(Err.Number, Err.Description)
    Resume ExitHere
End Sub

It's quite a bit longer, but I will shorten that up in time. Interesting how things work when you are referencing the fields in the recordset as opposed to the fields on the report/form!!!

Thanks Bob for the jump start! I needed that!