• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Excel cell values to Email using button

Vikungr

New Member
Good Evening all,

I am currently working on a quick side project for my department and the VBA is causing me a few issues. Could anybody here help me with writing a quick VBA module that would copy the data in the below cells (those in white) and paste them as the the .htmlbody for the button seen in the image labelled "Send Booking Request". I need to keep the data in the same kind of tabular format if at all possible. I just cant seem to get the thing to work.

Many thanks in advance.


78214
 
Hopefully the following will work for you :

Code:
Option Explicit

Sub send_email_via_outlook()

' Tools - Refrence - Microsoft Outlook
Dim olApp As New Outlook.Application
Dim olMail As MailItem

Set olMail = olApp.CreateItem(olMailItem)
    
    With olMail
        .To = "myemail@yahoo.com"
        .CC = ""
        .Subject = "Send Range as table in outlook"  '<br> used to insert a line ( press enter)
        .HTMLBody = "Hi Richard, <br> <br>" & "I have the following purchase request(s) for you, regarding the production of " & Sheet1.Range("G2").Value & ".<br><br> " & _
                    create_table(Sheets("Sheet1").Range("A1").CurrentRegion) & _
                    "</Table><br> <br>If you have any questions about my order request, please contact me on 079-44251826. <br> <br>" & _
                    "Thank you in advance,<br> <br>" & _
                    "Greetings Max<br><br>"
        .Display
        '.Send
    End With


End Sub

Function create_table(rng As Range) As String

Dim mbody As String
Dim mbody1  As String
Dim i As Long
Dim j As Long

' for html color codes list visit http://www.w3schools.com/html/html_colornames.asp

mbody = "<TABLE width=""65%"" Border=""1"", Cellspacing=""0""><TR>" ' configure the table

'create Header row
For i = 1 To rng.Columns.Count
    mbody = mbody & "<TD width=""100"", Bgcolor=""#A52A2A"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:18px"">" & rng.Cells(1, i).Value & "&nbsp;</p></Font></TD>"
Next

' add data to the table
For i = 2 To rng.Rows.Count
    mbody = mbody & "<TR>"
    mbody1 = ""
    For j = 1 To rng.Columns.Count
    mbody1 = mbody1 & "<TD><center>" & rng.Cells(i, j).Value & "</TD>"
    Next
    mbody = mbody & mbody1 & "</TR>"
Next

create_table = mbody
End Function


You'll need to change the following line as indicated below to B13

Code:
create_table(Sheets("Sheet1").Range("B13").CurrentRegion) & _

Also if the sheet name requires changing to match your project ... do so.
 

Attachments

  • WORKS - Email Range In Body Message.xlsm
    20.6 KB · Views: 3
Back
Top