Excel Macro To Create A New Email With A Range of Cells Included in the body

Hi Guys.. Fairly new to this.. It's been a while since I last did any kind of vba but I've managed to scramble together some code which creates an email, adds a subject title, gets an email from one of the cells for the person who its going to, adds text to the body of the email and copies a range of cells sticks them into a new excel file and adds this as an attachment to the email. However instead of the range of cells been added as an attachment I'd like to just add that range of cells into the body of the email along with a set template.

I'm using MS Office 2003 (MS Office Outlook & Excel 2003) to try and send the emails

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 27/08/2012 by Richard 
'
'The following subroutine sends a newly created workbook with just the visible cells in the Range("D1:J14")

   Dim Source As Range
   Dim Dest As Workbook
   Dim wb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim I As Long
   Dim OutApp As Object
   Dim OutMail As Object
   Dim Email As String
   Dim Ename As String
   Dim Strbody As String
   Dim MyDate As String
   
   Email = Range("C2")         'checks the range where the email is always located 
   MyDate = Range("L2")      'gets the date displayed in this cell which would always be todays date 
   Ename = Range("B2")       'gets the employee name to use at the beginning of the email 
      
This would just be the general template after a few tweeks to word it all correctly
   Strbody = "Dear " & Ename & "," & vbNewLine & vbNewLine & _
            "We have despatched the following cases to you today, " & MyDate & "." & "You should receive them within 48 hours of this email." & vbNewLine & _

             Here is where I would like to display the range of cells for the number of cases which are sent out (just in a table format) 

            "Upon receipt, please could you check that the packs contain everything that you need to complete the enquiry. If anything is missing or incomplete, or if you do not receive the packs within 48 hours, please let us know by replying to this email, or giving us a call on xxxx xxxx xxxx , so that we can investigate this for you immediately." & vbNewLine & _
            "If you have any queries, or if we can be of any further assistance please contact us on the details below." & vbNewLine & _
            "" & vbNewLine & _
            "Kind Regards" & vbNewLine & _
            "" & vbNewLine & _
            "Richard " & vbNewLine & _
            "__________________________________________________" & vbNewLine & _ (general signature text for email to be added here)
              
   Set Source = Nothing
   On Error Resume Next
   Set Source = Range("E1:J16").SpecialCells(xlCellTypeVisible)
   On Error GoTo 0

   If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
   End If

   With Application
        .ScreenUpdating = False
        .EnableEvents = False
   End With

   Set wb = ActiveWorkbook
   Set Dest = Workbooks.Add(xlWBATWorksheet)

   Source.Copy
   With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
   End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "List of EAR Cases " & Format(Now, "dd-mmm-yy")

   If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
   Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsx": FileFormatNum = 51
   End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

   With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
 '       For I = 1 To 3
 '           .SendMail "", _
 '                     "Cases Despatched" 'Call the email address & set the subject of the email itself
 '           If Err.Number = 0 Then Exit For
 '       Next I
 
         With OutMail
            .To = Email
            .CC = ""
            .BCC = ""
            .Subject = "Cases Despatched"
            .Body = Strbody
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display   'or use .Display / .send
        End With
 
 
        On Error GoTo 0
        .Close SaveChanges:=False
   End With


Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    'Delete the file you have send
'    Kill TempFilePath & TempFileName & FileExtStr
'
'    With Application
'        .ScreenUpdating = True
'        .EnableEvents = True
'   End With
End Sub

Any help would be greatly appreciated