asked on

VBA - How to add dynamic range to an email body?

I have code to create an email, but I don't know how to copy a range in excel to the body of the email. I need to add range "A14:G14" and all of the additional rows with data in column "A". I have formulas in 2 of the other columns.

Bill Prew

Take a look at my solution to this prior question, it should include enough to get you what you want. Basically it adds an HTML table to the email body and then populates it with data, which you can get from Excel sheet.

Send email alerts based off of col Value with message in email body Solutions | Experts Exchange

»bp

kbay808

ASKER

I see you code, but I'm a little confused how to modify it to work in my situation.

Private Sub SendEmails(ws As Worksheet, emailQueue As Object)
' Local variables
Dim emailTo As Variant
Dim emailData As OwnerData
Dim emailBody As String
Dim emailTable As String
Dim emailDetail As String
Dim row As Variant
Dim outlookApp As Object
Dim total As Double

' Connect to Outlook
Set outlookApp = CreateObject("Outlook.Application")

' Process each email that needs a reminder sent
For Each emailTo In emailQueue.Keys

' Get the email address
Set emailData = emailQueue(emailTo)

emailTable = ""

' Add second reminders (if there are any)
If emailData.ExpiredSecond <> "" Then
emailDetail = ""
total = 0

' Add details for each license
For Each row In Split(emailData.ExpiredSecond, ",")
' Generate the HTML for this detail line and add to this table
emailDetail = emailDetail & BodyDetail(ws, CLng(row))
total = total + ws.Cells(row, colTotalPayment).value
Next

' Generate the HTML for this table and add it to the tables for this email
emailTable = emailTable & BodyTable(SecondReminderDays, Format(total, "Currency"), emailDetail)
End If

' Add first reminders (if there are any)
If emailData.ExpiredFirst <> "" Then
emailDetail = ""
total = 0

' Add details for each license
For Each row In Split(emailData.ExpiredFirst, ",")
' Generate the HTML for this detail line and add to this table
emailDetail = emailDetail & BodyDetail(ws, CLng(row))
total = total + ws.Cells(row, colTotalPayment).value
Next

' Generate the HTML for this table and add it to the tables for this email
emailTable = emailTable & BodyTable(FirstReminderDays, Format(total, "Currency"), emailDetail)
End If

' Generate the HTML for this email body
emailBody = BodyMain(emailData.Name, emailTable)

' Create an email and send it (via Outlook)
With outlookApp.CreateItem(0)
.to = emailTo
.Subject = "Friendly Reminder"
.HtmlBody = emailBody
.Send
End With

Next

' Disconnect from Outlook
Set outlookApp = Nothing

End Sub

Bill Prew

Might be easier if you share your current code and I can make some suggestions on what to add where...

»bp

kbay808

ASKER

I now got to this point. I'm able to select the range that I want with the below code.

Range(Sheet11.Range("A13:A1000").Find("*"), Sheet11.Range("A" & Rows.Count).End(xlUp)).EntireRow.Resize(, 7) .Select

Now this is the issue that I'm getting a runtime error on the below line.

Dim worklog As String

worklog = Range(Sheet11.Range("A13:A1000").Find("*"), Sheet11.Range("A" & Rows.Count).End(xlUp)).EntireRow.Resize(, 7)

Subject = worklog

Norie

kbay808

How do you want the data to appear in the body of the email?

kbay808

ASKER

That's a good question that I didn't really think about. I would like it to be in a table.

Norie

So A14:G14 is the headers and then you have rows of data below that?

kbay808

ASKER

There are no headers. It's all data.

Norie

Have a look at the simple example in the attached workbook.
Email-with-table.xlsm

kbay808

ASKER

Ok, I tried a couple different ways and the data does not look right. I can get it to look perfect by coping the data and then manually pasting it into the email. Is there a way to do that?

Bill Prew

Just because I was playing around with this and then got pulled away. Here's a sample of the table HTML, and the resulting table when rendered (with some test data here).

Sub Test()
    Dim Sheet11 As Worksheet
    Set Sheet11 = ActiveSheet

    Dim rng As Range
    Set rng = Application.Range(Sheet11.Range("A13:A1000").Find("*"), Sheet11.Range("A" & Rows.Count).End(xlUp))
    
    Dim r As Integer
    Dim c As Integer
    Dim table As String
    
    table = ""
    table = table & "<table style='color: black; border-collapse:collapse; border: 1px solid blue' cellpadding='5'>" & vbCrLf
    For r = 1 To rng.Rows.Count
        table = table & "<tr>" & vbCrLf
        For c = 1 To rng.Rows.Count
            table = table & "<td style='color: black; border: 1px solid blue'>" & rng.Cells(RowIndex:=r, ColumnIndex:=c).Value & "</td>" & vbCrLf
        Next
        table = table & "</tr>" & vbCrLf
    Next
    table = table & "</table>" & vbCrLf
    
    Debug.Print table
End Sub

Open in new window

»bp

Bill Prew

Were you already generating the body of the email in HTML format, or just plain text?

What about your results didn't look right?

Generating the table in HTML should be the easier route, but I imagine there is a way to copy / paste it. But that starts to feel like an embedded attachment, and that code get's complicated quick to build up the needed email in VBA, it wouldn't be the way I approached it...

»bp

Martin Liss

emailbody = <should be a table or named range>

Norie

kbay800

How the data looks in the body of the email depends on what styling you apply to the HTML table.

The main difference, as far as I can see anyway, between Bill and my code is the use of cell padding in the table.

You could use that, and any other styling you want to get the desired result

Bill Prew

It would be good to have your Excel file you are testing with, the VBA code that you are running, and the resulting email that didn't look the way you want it to...

»bp

kbay808

ASKER

Here is an example file.
Example-File.xlsm

Bill Prew

A few adjustments for you to try. Also I had to rename Sheet1 to Data.

Sub Email()
    
    Dim OL_App As Object
    Dim OL_Mail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set rng = ActiveSheet.UsedRange
   
    Set OL_App = CreateObject("Outlook.Application")
    Set OL_Mail = OL_App.CreateItem(0)

    With Destwb
        htmlBody = "<html><body style='font-family: Calibri, Verdana, Helvetica, sans-serif;'>"
        htmlBody = htmlBody & RngToHTML(Sheets("Data").Range("A14").CurrentRegion)
        htmlBody = htmlBody & "</body></html>"

        On Error Resume Next
        With OL_Mail
            .To = ""
            .BCC = ""
            .Subject = "Test"
            .htmlBody = htmlBody
            .display '.Send
        End With
        On Error GoTo 0
    End With


    Set OL_Mail = Nothing
    Set OL_App = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Open in new window

»bp

kbay808

ASKER

Please take a look at the attached screen shot. It works, but in my working copy I have data the first 11 rows and it's getting added to the email too.
Screen-shot.JPG

Bill Prew

That will be a function of that range you are selecting as the data source, check out what that is returning and why.

»bp

ASKER CERTIFIED SOLUTION

Norie

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

kbay808

ASKER

Sorry for the delay, I just got back from my vacation. It worked great. Thank you very much.