place each record from recordset in new line in email body

[diarmaidbrown]

Hey again thanks for all the help so far you guys have been great.
Im using recordset to place data in the body of an email problem im facing i cant get each record on a new line in the email body,

The code i have done is

Private Sub Command29_Click()
Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim Sttext As String
Dim sSQL As String
Dim BSN As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Bookings As String
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set db = CurrentDb
strSQL = "SELECT Dates.DateofBooking, Dates.TypeofBooking, Dates.NumberinGroup, Dates.ActivityStartTime, Dates.ActivityEndTime FROM Dates WHERE Dates.BSN = 1;"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

Do Until Recordset.EOF
Bookings = "Booking Date: " & rs.Fields("DateofBooking").Value & "Activity: " & rs.Fields("TypeofBooking").Value & "Number in Group " & rs.Fields("NumberinGroup").Value

Recordset.MoveNext

Bookings = "Booking Date: " & rs.Fields("DateofBooking").Value & "Activity: " & rs.Fields("TypeofBooking").Value & "Number in Group " & rs.Fields("NumberinGroup").Value

Loop




' Clean Up and go home.
Set rs = Nothing
Set db = Nothing




With MailOutLook
.BodyFormat = olFormatHTML
.To = Me.EmailAddress
.Subject = "Hi"
.Body = "Please Confirm the details below are correct" & vbCrLf & _
"Your Booking REference number is:" & Me.BSN & vbCrLf & _
"Address: " & Me.Address & vbCrLf & _
"Town" & Me.Town & vbCrLf & _
"Contact Number: " & Me.Telephone & vbCrLf & _
Bookings & vbCrLf & _
"Extra Comments: " & ExtraComments & vbCrLf & vbCrLf & "Booking Taken By: " & BookenTakenBy & vbCrLf & vbCrLf & "This is an automated message. Please do not respond to this e-mail."

.Send
End With

Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:
End Sub

Any advice to point me in the right direction is welcome no matter how trival you think it might be as "i think i need a bigger boat"

 

[PNGBill]

Here is an extract of email code that does work for multiply records.
Trust it makes sence.

           'SQL to Collect Loan Data for All Current Loans - Issued but not completed
    strSQL = "SELECT TBLACCDET.ADPK, TBLLOAN.LDPK AS LoanID, TBLLOAN.LDTerm, TBLAPPLOAN.APLSTAT, tblLoanIssueStatus.IssueDate AS DateLoanIssued, TBLLOAN.LDPrin AS LoanPrincipal, TBLLOAN.LDPayK AS LoanRepayAmt, LastLoanRepayAmt(CStr([LoanID])) AS LastRepayAmt, LastLoanRepayDate(CStr([LoanID])) AS LastRepayDate, NZ(QryLoanCurrentBalanceResult.LoanCurrentBalance, 0) AS LoanOverdueAmt, NZ(QryLoanTotalToPayResult.SumOfLoanTotalToPay, 0) AS LoanTotalToPay " & _
        "FROM tblLoanIssueStatus INNER JOIN (TBLAPPLOAN INNER JOIN (((TBLACCDET INNER JOIN TBLLOAN ON TBLACCDET.ADPK = TBLLOAN.ADPK) INNER JOIN QryLoanTotalToPayResult ON TBLLOAN.LDPK = QryLoanTotalToPayResult.LoanID) INNER JOIN QryLoanCurrentBalanceResult ON TBLLOAN.LDPK = QryLoanCurrentBalanceResult.LoanID) ON TBLAPPLOAN.APLPK = TBLLOAN.LoanAppID) ON tblLoanIssueStatus.LoanID = TBLLOAN.LDPK " & _
        "WHERE (((TBLACCDET.ADPK)=" & MembID & ") AND ((TBLLOAN.LDTerm)=1) AND ((TBLAPPLOAN.APLSTAT)=3));"
    
                    'Open Recordset
    Set rst = dbs.OpenRecordset(strSQL)
    
    EmailBody = "Loan               Principal           Date               Agreed             Last               Repay           Overdue          Total" & Chr(13) & Chr(10)
    EmailBody = EmailBody & "Number          Amount           Issued            Repayment     Repayment        Date              Amount          Amount" & Chr(13) & Chr(10)
   
    Do Until rst.EOF
    
    EmailText = LoanNumberFormat(rst!LoanID) & Space(15 - Len(LoanNumberFormat(rst!LoanID))) & Format(rst!LoanPrincipal, "Currency") & Space(15 - Len(Format(rst!LoanPrincipal, "Currency"))) & rst!DateLoanIssued & Space(15 - Len(rst!DateLoanIssued)) & Format(rst!LoanRepayAmt, "Currency") & Space(15 - Len(Format(rst!LoanRepayAmt, "Currency"))) & Format(rst!LastRepayAmt, "Currency") & Space(15 - Len(Format(rst!LastRepayAmt, "Currency"))) & rst!LastRepayDate & Space(15 - Len(rst!LastRepayDate)) & Format(rst!LoanOverdueAmt, "Currency") & Space(15 - Len(Format(rst!LoanOverdueAmt, "Currency"))) & Format(rst!LoanTotalToPay, "Currency") & Chr(13) & Chr(10)
    EmailBody = EmailBody & EmailText
    
    rst.MoveNext
    
    Loop
   
    If LastRepayDate > Date - 15 Then
        stSubjectWeight = "Friendly Reminder"
        stEmailOpen = "Dear "
        stEmailClose = "Kind Regards,"
    ElseIf LastRepayDate < Date - 45 Then
        stSubjectWeight = "Promised Repayment Overdue"
        stEmailOpen = ""
        stEmailClose = "Please Respond Urgently,"
    Else
        stSubjectWeight = "Reminder"
        stEmailOpen = ""
        stEmailClose = "Regards,"
    End If
    
    PointsAvailable = GetMemClubPointsAvailable(MembID)   'Set Function Result as variable value
        
    stSubject = stSubjectWeight & " - Member Loan Balances Details for " & FullName & " - Member Number " & MemberIDFormat(CStr(MembID))
    stText = stEmailOpen & FirstName & "," & Chr(10) & Chr(10) & _
             "Our Records show your Current Loan Details with Club Group Limited are as follows:" & Chr(13) & Chr(10) & Chr(10) & _
             EmailBody & Chr(13) & Chr(10) & Chr(10) & _
             "Your Club Points Balance is " & PointsAvailable & Chr(13) & Chr(10) & Chr(10) & _
             stEmailClose & Chr(13) & Chr(10) & _
             TeamMember & Chr(10) & Chr(10) & _
             ContactDetailBasic & Chr(10) & Chr(10) & _
             SeasonMessage
     
            'Write the e-mail content for sending to assignee
    DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, -1

 

[diarmaidbrown]

Hey thanks fro the repy. So i changed my Recordset loop but it still only shows the first value of the record cant figure out how to get the rest of the data showing.

 

[diarmaidbrown]

This is what the code looks like now

Private Sub Command29_Click()
 Dim mess_body As String
        Dim appOutLook As Outlook.Application
        Dim MailOutLook As Outlook.MailItem
        Dim Sttext As String
        Dim sSQL As String
        Dim BSN As String
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim Bookings As String
        Dim EmailText As Variant
        Dim EmailText2 As String
        Dim EmailBody As Variant
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)
        Set db = CurrentDb
        strSQL = "SELECT Dates.DateofBooking, Dates.TypeofBooking, Dates.NumberinGroup, Dates.ActivityStartTime, Dates.ActivityEndTime FROM Dates WHERE Dates.BSN = 1;"
        Set rs = db.OpenRecordset(strSQL)
        
        EmailBody = "Date of Booking               Activity           Number in Group               Start Time             End Time" & Chr(13) & Chr(10)
        EmailBody = EmailBody
   
        
        With rst
            Recordset.MoveFirst
            Do While Not Recordset.EOF
       
            EmailText = rs.Fields("DateofBooking").Value & Space(20 - Len(rs.Fields("DateofBooking").Value)) & rs.Fields("TypeofBooking").Value & Space(50 - Len(rs.Fields("TypeofBooking").Value)) & rs.Fields("NumberinGroup").Value & Space(20 - Len(rs.Fields("NumberinGroup").Value)) & rs.Fields("ActivityStartTime").Value & Space(20 - Len(rs.Fields("ActivityStartTime").Value)) & rs.Fields("ActivityEndTime").Value & Space(20 - Len(rs.Fields("ActivityEndTime").Value)) & Chr(13) & Chr(10)
           EmailBody = EmailBody & EmailText
       
            Recordset.MoveNext
        
            
         Loop
        
        End With
        
       rs.Close
        Set rs = Nothing
        Set db = Nothing
        
           
            
            
            With MailOutLook
            .BodyFormat = olFormatHTML
            .To = Me.EmailAddress
            .Subject = "Hi"
             .Body = "Please Confirm the details below are correct" & vbCrLf & _
                     "Your Booking REference number is:" & Me.BSN & vbCrLf & _
                     "Address: " & Me.Address & vbCrLf & _
                     EmailBody & vbCrLf & _
                     "Town" & Me.Town & vbCrLf & _
                     "Contact Number: " & Me.Telephone & vbCrLf & _
                     Bookings & vbCrLf & _
                     "Extra Comments: " & ExtraComments & vbCrLf & vbCrLf & "Booking Taken By: " & BookenTakenBy & vbCrLf & vbCrLf & "This is an automated message. Please do not respond to this e-mail."

            .Send
            End With
            
            Exit Sub
email_error:
            MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
            Resume Error_out
Error_out:
End Sub

 

[PNGBill]

Test your SQL query as a query to confirm it returns the records you expect.
I had an issue with some multiply records not appearing on the email and it was the sql that didn't collect all data.

Once you have confirmed the data is collected then check your VBA code.

 

[PNGBill]

When posting code, click on the hash key and paste your code between the two Code words that will appear on your screen.

 

[ChrisO]

There is a lot wrong with the code, this is just two of them:-

Set [color=red]rs[/color] = db.OpenRecordset(sSQL, dbOpenDynaset)
Do Until [color=red]Recordset[/color].EOF
    [color=green]' Some Blah[/color]
    [color=red]Recordset[/color].MoveNext
    [color=green]' More of the same Blah[/color]
Loop

Chris.