Not able to display all record in email

[neha2604]

I am using the below code to display all the record based on a condition, but it is displaying the last record.

               Dim objOutlook As Outlook.Application
               Dim objOutlookMsg As Outlook.MailItem
               Dim objOutlookRecip As Outlook.Recipient
               Dim objOutlookAttach As Outlook.Attachment
               Dim PLT As New ADODB.Connection
               Dim MyRecSet As New ADODB.Recordset

               Set PLT = New ADODB.Connection
               PLT.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=H:\ActionItem.mdb;"
               PLT.Open
               Set MyRecSet.ActiveConnection = PLT
               MyRecSet.CursorLocation = adUseClient
               MyRecSet.Open ("SELECT New_Action_Item,Assignee,Status,Description,Start_Date,End_Date,Action_ID FROM Action_item where status = 'open' ")
Set objMessage = CreateObject("CDO.Message")

          ' Create the Outlook session.
          Set objOutlook = CreateObject("Outlook.Application")

          ' Create the message.
          Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

          With objOutlookMsg
              ' Add the To recipient(s) to the message.
              Set objOutlookRecip = .Recipients.Add("xyz.com")
              objOutlookRecip.Type = olTo

             ' Set the Subject, Body, and Importance of the message.
             .Subject = "Action Item From Team Meeting"
            Do While Not MyRecSet.EOF

             .Body = objMessage.TextBody & MyRecSet(0) & "     " & MyRecSet(1) & "    " & MyRecSet(2) & "   " & MyRecSet(3) & "   " & MyRecSet(4) & "    " & MyRecSet(5) & "     " & MyRecSet(6)
             
            MyRecSet.MoveNext
            Loop

             ' Resolve each Recipient's name.
             For Each objOutlookRecip In .Recipients
                 objOutlookRecip.Resolve
             Next

             ' Should we display the message before sending?
             
                 '.Save
                 .Send
           
          End With
          Set objOutlook = Nothing

[Rabbit]

That's because you keep overwriting the Body of your email instead of appending to it. And for some reason you're using 2 different message objects.