Copy attachment contents into body of email !

Hi all.

I have the following code that is being used to send an attachment via email.

IS there something I can add to the code that will allow the contents of a sheet to be copied and pasted into the body of the email.

Any help would be much appreciated

Option Explicit


Sub Button1_Click()

    Dim lErrorNo    As Long
    Dim OutMail     As Object
    Dim myEmail     As String
    Dim OutApp      As Object
    Dim xNmae       As Object

    If ThisWorkbook.Saved = True Then

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

          myEmail = xNmae.Session.CurrentUser.AddressEntry. _
                          GetExchangeUser.PrimarySmtpAddress

          With OutMail

              .To = "XXXX;XXXXX"
              .CC = myEmail
              .BCC = ""
              .Subject = "Ad Hoc Report Request"
              .Body = "Hi. Please find attached my ad hoc request form."
              .Attachments.Add ActiveWorkbook.FullName

              On Error Resume Next
                  .Send
'                 Record the number of any error which may have occurred
                  lErrorNo = Err.Number
              On Error GoTo 0

'             Display a "Success" or "Failure" message as appropriate
              If lErrorNo = 0 Then
                    MsgBox "Your request has succesfully been sent by email.You may now close the workbook", vbInformation
              Else: MsgBox "An error occurred - the email was NOT sent", vbCritical
              End If

          End With

    Else: MsgBox "Please save the workbook first..", vbInformation

    End If

    Set OutMail = Nothing
    Set OutApp = Nothing
    Set xNmae = Nothing

End Sub