EXCEL macro : Generating Outlook HTML style email with table

In this post I will show how to create HTML style Outlook email using VBA.

In the example, I will create table inside the mail and using excel cells reference as the items for the table.

=====================================================
 Sub Mail()  
 Dim App As Object  
 Dim item As Object  
 Dim StrBody As String  
 Dim StrBody2 As String  
 Dim sAttachment As String  
 'Make attachment a string because it is the path being attached  
 On Error GoTo ende  
 esubject = "This is a test mail"  
 sendto = "me@gmail"  
 ccto = "me@gmail "  
 'sAttachment = strzipFile  
 StrBody = "This my test mail" & "<br>" & "<br>" & _  
 "This is for learning purposes" & "<br>" & _  
 "Let me know if you need anything" & "<br>" & _  
 "Don't hesitate" & "<br>" & "<br>"  
 Data1 = Sheet1.Cells(3, 2).Value  
 Data2 = Sheet1.Cells(4, 2).Value  
 Data3 = Sheet1.Cells(5, 2).Value  
 Data4 = Sheet1.Cells(6, 2).Value  
 Data5 = Sheet1.Cells(7, 2).Value  
 Data6 = Sheet1.Cells(8, 2).Value  
 HTML = "<HTMl><BODY><table border=""1"" width=""750"">"  
 ROW1 = "<tr><td width=""50"">#</td><td width=""200"">Item no</td><td width=""500"">Item</td></tr>"  
 ROW2 = "<tr><td width=""50"">1</td><td width=""200"">Item1</td><td width=""500"">" & Data1 & "</td></tr>"  
 ROW3 = "<tr><td width=""50"">2</td><td width=""200"">Item2</td><td width=""500"">" & Data2 & "</td></tr>"  
 ROW4 = "<tr><td width=""50"">3</td><td width=""200"">Item3</td><td width=""500"">" & Data3 & "</td></tr>"  
 ROW5 = "<tr><td width=""50"">4</td><td width=""200"">Item4</td><td width=""500"">" & Data4 & "</td></tr>"  
 ROW6 = "<tr><td width=""50"">5</td><td width=""200"">Item5</td><td width=""500"">" & Data5 & "</td></tr>"  
 ROW7 = "<tr><td width=""50"">6</td><td width=""200"">Item6</td><td width=""500"">" & Data6 & "</td></tr></table>"  
 ebody = HTML & ROW1 & ROW2 & ROW3 & ROW4 & ROW5 & ROW6 & ROW7  
 StrBody2 = "<br>" & "<br>" & _  
 "Thank you" & "<br>" & "<br>" & _  
 "Nidzam" & "<br>"  
 Set App = CreateObject("Outlook.Application")  
 Set itm = App.CreateItem(olMailItem)  
 With itm  
 .Subject = esubject  
 .To = sendto  
 .cc = ccto  
 '.Attachments.Add (strzipFile)  
 .HTMLBody = StrBody & ebody & StrBody2  
 .Display  
 Set App = Nothing  
 Set itm = Nothing  
 ende:  
 End With  
 End Sub  
=====================================================
below are the output


No comments:

Post a Comment