VBA send email with multiple cells in body

[pimco123]

Hi

Would someone be able to help with the VBA code to get VBA to send a table of data from excel using Outlook?

Eg: how do you get the below table of data (spread across 4 rows and 4 colulmns) into an Outlook email body?

Account Water Earth Fire
123 48 7 6
1234 4 65 0
12345 54 74 4


I have the below code which I use to generate emails but the body field of the email only picks up data from one column, I am trying to include the above table into the email body.

Thank you so much

Sub Email12()
EmailNo = 0
Range("B2").Select
Do Until ActiveCell.Offset(0, -1) = Range("C2").Value
ActiveCell.Offset(1, 0).Select
Loop

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ActiveCell.Offset(0, 1).Value
.CC = ActiveCell.Offset(1, 1).Value
.Subject = ActiveCell.Offset(2, 1).Value

Do Until ActiveCell.Value = "Subject:"
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.Offset(1, 0).Select

Do Until ActiveCell.Value = Range("C3")
ActiveCell.Offset(1, 0).Select
.body = .body + ActiveCell.Value + vbCrLf

Loop

.Display

End With
Range("A1").Select

End Sub

 

[hippiehacker]

look at this site for many many examples Mail from Excel with Outlook (VBA)

 

[apo]

Hi..

Please post some more details...

1. What is the range that your table is in?... is it static or dynamic (variable amount of rows)..?

2. What sheet is it on.. (not super important.. but it will make it easier for you..)...

As hippiehacker says.. there are many examples on Ron de Bruins site..

If you can't work it out.. post back the details i asked.. and i will post code that will do it..

 

[pimco123]

thanks for your replies - i will take a look at that website.

I have a spreadsheet with one worksheet, there are 20-30 email templates that look like the below. I have written a VBA code that generates an outlook email with data from the relevant email template in my spreadsheet.

I have the below email data in my Sheet1, basically i'm trying to get the table of 2000-2002 data into the email body. I would like to make the code as dynamic as possible as there are 20-30 different emails in my spreadsheet, some with tables with 3-5 columns.

To:</SPAN>	abc@example.com</SPAN>
Cc:</SPAN>	abcd@example.com
Subject:</SPAN>	Test subject
**empty row**
Hi ABC,</SPAN>
**empty row**
Please see below table:
**empty row**
</SPAN>2000 2001 2002	1,999,999 223,245,232 123,234,645
**empty row** **empty row**			</SPAN>
Kind Regards,</SPAN>
ABC DEF

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL></COLGROUP>

This is my code, you simply enter the email number you want to send in cell B2 and it will generate the outlook email. Currently it generates the email correctly with the to, cc, subject, body etc, just cant seem to get a table into the body.

thank you in advance.

Sub Email12()
EmailNo = 0
Range("B2").Select
Do Until ActiveCell.Offset(0, -1) = Range("C2").Value
ActiveCell.Offset(1, 0).Select
Loop


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ActiveCell.Offset(0, 1).Value
.CC = ActiveCell.Offset(1, 1).Value
.Subject = ActiveCell.Offset(2, 1).Value

Do Until ActiveCell.Value = "Subject:"
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.Offset(1, 0).Select

Do Until ActiveCell.Value = Range("C3")
ActiveCell.Offset(1, 0).Select
.body = .body + ActiveCell.Value + vbCrLf
Loop

.Display

End With
Range("A1").Select

End Sub

 

[apo]

Hi..
Here is an example of adding a table into the body of an email..

To recreate this sample.. Add this to your Sheet code in the VB Editor..

(Change variables like sheet name and subject etc to suit.. and link it to a ActiveX Command button)

Private Sub CommandButton1_Click()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
    Dim OutApp As Object, OutMail As Object
    Dim rng As Range
    Dim StrBody As String
    StrBody = "Add some custom text" & "<br>" & _
              "This is line 2" & "<br>" & _
              "This is line 3" & "<br><br><br>"


    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    Set rng = Nothing
    On Error Resume Next


    Set rng = Sheets("Purchase").Range("A1:G7").SpecialCells(xlCellTypeVisible)


    On Error GoTo cleanup
 


            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = Sheets("Purchase").Cells(1, 10).Value
                .Subject = "Purchase Order Data"
                .HTMLBody = StrBody & RangetoHTML(rng)
               
                .Display  'Or use .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing


cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True


End Sub

Then add this code to a Module..

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Here's a screenshot of what the layout looked like so you can recreate the sample yourself.
<b>Purchase</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:97px;" /><col style="width:46px;" /><col style="width:86px;" /><col style="width:49px;" /><col style="width:29px;" /><col style="width:67px;" /><col style="width:43px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:138px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td><td >J</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >Received Date</td><td >PO No</td><td >Part Number</td><td >details</td><td >Qty</td><td >Unit Pirce</td><td >Value</td><td > </td><td > </td><td style="color:#0000ff; text-decoration:underline; ">test@gmail.com</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="text-align:right; ">2/02/2013</td><td style="text-align:right; ">10</td><td >ABCD</td><td >XXX</td><td style="text-align:right; ">30</td><td style="text-align:right; ">900</td><td style="text-align:right; ">22500</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="text-align:right; ">3/03/2013</td><td style="text-align:right; ">11</td><td >ABCD</td><td >XXX</td><td style="text-align:right; ">40</td><td style="text-align:right; ">920</td><td style="text-align:right; ">46000</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">6/03/2013</td><td style="text-align:right; ">12</td><td >ABCD</td><td >XXX</td><td style="text-align:right; ">30</td><td style="text-align:right; ">950</td><td style="text-align:right; ">28500</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="text-align:right; ">6/04/2013</td><td style="text-align:right; ">13</td><td >ABCD</td><td >XXX</td><td style="text-align:right; ">20</td><td style="text-align:right; ">940</td><td style="text-align:right; ">18800</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="text-align:right; ">19/05/2013</td><td style="text-align:right; ">14</td><td >ABCD</td><td >XXX</td><td style="text-align:right; ">10</td><td style="text-align:right; ">925</td><td style="text-align:right; ">9250</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">10/05/2013</td><td style="text-align:right; ">15</td><td >ABCD</td><td >XXX</td><td style="text-align:right; ">15</td><td style="text-align:right; ">970</td><td style="text-align:right; ">14550</td><td > </td><td > </td><td > </td></tr></table> <br />Excel tables to the web - Excel Jeanie Html 4

As you can see.. it is using a static range for the table (A1:G7)..

I am a bit confused about what exactly you're doing.. it sounds like you have 20-30 sheets with a similar layout for each email you want sent (and a table on each sheet).. is that correct?

It would be better to have all your table data for everyone in the same table and do something like autofilter the table for the info you want sent in any particular email..

Try using Excel Jeanie to post actual screenshots of your sheet like I have in this post.. it makes it clearer for others to get a better picture of what you're doing..

 

[pimco123]

Thanks for your help apo - really appreciate it

 

[pimco123]

Hi Apo

Sorry i'm not able to post pics using excel jeanie (work policy against installing programs). I tried your script and it generated an email with a table of data (5 columns by several rows) which is exactly the problem i was trying to solve, thanks.

What's the reason you have two separate codes, why did you need to have the second code: Function RangetoHTML(rng As Range)

Also, is it possible to set the table dynamic instead of static (A1:G7) as the table may move and expand etc.

 

[apo]

Hi..

What's the reason you have two separate codes, why did you need to have the second code: Function RangetoHTML(rng As Range)

Also, is it possible to set the table dynamic instead of static (A1:G7) as the table may move and expand etc.

This should answer both of your questions..

This line is setting the range of your table and calling it "rng".

[COLOR=#333333]Set rng = Sheets("Purchase").Range("[/COLOR][COLOR=#ff0000]A1:G7[/COLOR][COLOR=#333333]").SpecialCells(xlCellTypeVisible)[/COLOR]

Then.. this line is pushing that range (rng) into the Function called (RangetoHTML). The Function (the second piece of code you referred to).. is what is doing all the hard work (converting your range to html), so it can then be inserted into your email body..

[COLOR=#574123].HTMLBody = StrBody & [/COLOR][COLOR=#ff0000]RangetoHTML(rng)[/COLOR]

So.. to make it so the range is dynamic.. you could for example:

Find LastRow used in Column "A".

LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

Find Last Column with data in it in row 1.

LastCol[COLOR=#333333][FONT=arial] = Range("IV1").End(xlToLeft).Column [/FONT][/COLOR]

And using that.. you could change the line that sets your range to something like..

[COLOR=#333333]Set rng = Sheets("Purchase").Range(Cells(1,1),Cells(LastRow,LastCol))[/COLOR][COLOR=#333333].SpecialCells(xlCellTypeVisible)[/COLOR]

That should make it so your range starts at A1 and goes down to where the last used cell is in Column A and out to the right as far as the last used cell in row 1..

I hope i have explained that correctly for you..

 

[pimco123]

brilliant - thanks so much again.

 

[Utradeshow]

I used search, and this will work perfect with my application. However, the range I need to copy has our logo in it and is NOT copying over? Is there a way to copy the range as a picture? If I copy the range manually and paste into Outlook as a picture the format is perfect.

Thank you,
Dan