Copying range of Excel cells into body of email via VBA

[stevethomas56]

Hi - I have written a macro to send an email (with attachment) to named recipients. It all works fine except that it won't copy the range of excel cells into the body of the email.

I have highlighted the part that is not working in bold below. The range "email_narrative" is the predefined excel range of data in the source workbook which I want to paste in the body of the email.

Any ideas why this is not working?




Sub emailsender()

Dim SplitsTo As String
Dim SplitsCC As String
Dim AllocationsTo As String
Dim AllocationsCC As String
Dim TempFileName As Variant
Dim Tempmessage As Variant

'Splits Distribution List
SplitsTo = Sheets("Checks").Range("email_to").Value
SplitsCC = Sheets("Checks").Range("email_cc").Value
TempFileName = Sheets("Checks").Range("email_subject").Value
Tempmessage = Sheets("Checks").Range("email_narrative").Value

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = SplitsTo
.Cc = SplitsCC
.Subject = TempFileName
.Body = Tempmessage
.Attachments.Add Application.ActiveWorkbook.FullName
.Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

 

[starl]

Body is a string and you're trying to place an array in it. Not compatible.
You need to get the html that creates the table you would get from a manual copy/paste. You do this by copying the range to a new workbook, publishing that range to a temp html file, then copying the html to your email. There's also a solution to copy/paste with the clipboard, but that can get iffy, depending on programs running in the background interfering with the clipboard.

Ron de Bruin has an example setup on his site. The relevant piece is the RangeToHTML code:
https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

 

[shknbk2]

I'm guessing your email_narrative range has multiple cells. If so, Tempmessage ends up being a 2-dimensional array. Pasting the array as a string into the Body doesn't work.

One workaround is the following (modified as necessary):

Sub emailsender()

Dim SplitsTo As String
Dim SplitsCC As String
Dim AllocationsTo As String
Dim AllocationsCC As String
Dim TempFileName As Variant
Dim Tempmessage As Variant

'Splits Distribution List
SplitsTo = Sheets("Checks").Range("email_to").Value
SplitsCC = Sheets("Checks").Range("email_cc").Value
TempFileName = Sheets("Checks").Range("email_subject").Value

Dim narrativeCell As Range
For Each narrativeCell In Sheets("Checks").Range("email_narrative")
    If Tempmessage = "" Then
        Tempmessage = narrativeCell.Value
    Else
        Tempmessage = Tempmessage & vbCrLf & narrativeCell.Value
    End If
Next

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = SplitsTo
.Cc = SplitsCC
.Subject = TempFileName
.Body = Tempmessage
.Attachments.Add Application.ActiveWorkbook.FullName
.Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

Additional features might include addressing the cells that are empty and not appending them.