Copying multiple cell contents into body of email using VBA

[Lizard07]

Hi - I would like the body of the email to contain the contents of multiple cells. Using the code I have below, if I select more than one cell as the body nothing appears in the email. Please advise

Sub SendStatusUpdateEmail()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurrFile As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
ActiveWorkbook.Save
CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With olMail
.To = ajfkljfljf@dskljaf.com
.Subject = "Status Update"
.Body = ActiveSheet.Range("M8:M9").Text & vbCrLf
.Display '.Send
End With
Set olMail = Nothing
Set olApp = Nothing
End Sub

 

[Ruddles]

Do this:-

.Body = ActiveSheet.Range("M8").Text & ActiveSheet.Range("M9").Text & vbCrLf

 

[Trevor G]

Why have this

CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name


When

CurrFile = ActiveWorkbook.FullName

is easier.

 

[Lizard07]

Thank-you that worked, but how do you separate the cell data with a space, is that possible. And is it possible to copy multiple cells, i.e. start in the same cell each time then ctrl shift down highlighting all cells with text.

 

[Trevor G]

Try this using this, it using send key which is the same as copy and paste.

Sub EmailRange()
'*******************************************************************************
'This code requires you to Set the References. GoTo Tools > Reference >Search
'For Microsoft Outlook (A number) .Object Library and tick the box
'The following sample will look to email a filtered list of data with todays date
'Created by Trevor G
'May 2011
'*******************************************************************************
Dim OutlookApp As Outlook.Application
Dim MailSelection As Object
Dim cell As Range
Dim Subject As String
Dim EmailAddress As String
ThisWorkbook.Sheets("Karl To Elsie").Select
Range("A3").Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$j$35").AutoFilter Field:=4, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic 'Adjust the range of cells
Range("A3").Select
ActiveCell.CurrentRegion.Copy
Set OutlookApp = CreateObject("Outlook.Application")
Set MailSelection = OutlookApp.CreateItem(0)
With MailSelection
.To = "trevor@xxxxx.com" 'Change to email address
.Subject = "Invoice"
.Display 'Change to send once checked.
SendKeys "^({v})", True 'This is the same as using Paste
End With
' End If
'Next
End Sub