Insert text, hyperlink and table in the mail body

Question

I am trying to insert text, hyperlink and table in the mail body.

Sub Sendmail()

    Dim olItem As Outlook.MailItem
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSht As Excel.Worksheet
    Dim sPath As String
    Dim iRow As Long
    Dim strRFIitems As String
    Dim Signature As String

    sPath = "**"

    '   // Excel    
    Set xlApp = CreateObject("Excel.Application")

    '   // Workbook
    Set xlBook = xlApp.Workbooks.Open(sPath)

    '   // Sheet
    Set xlSht = xlBook.Sheets("Sheet1")

    '   // Create e-mail Item
    Set olItem = Application.CreateItem(olMailItem)
    trRFIitems = xlSht.Range("E2")
    Signature = xlSht.Range("F2")

    With olItem
        .To = Join(xlApp.Transpose(xlSht.Range("A2", xlSht.Range("A9999").End(xlUp))), ";")    
        .CC = Join(xlApp.Transpose(xlSht.Range("B2", xlSht.Range("B9999").End(xlUp))), ";")
        .Subject = xlSht.Range("C2")
        .Body = xlSht.Range("D2") & Signature
        .Attachments.Add (strRFIitems)
        .Display
    End With

    '   // Close
    xlBook.Close SaveChanges:=True

    '   // Quit
    xlApp.Quit

    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSht = Nothing
    Set olItem = Nothing

End Sub

This code retrieves the data from the linked Excel sheet and sends a mail.

The requirement is:

Retrieve the To, CC, Body, Subject and signature data from the linked Excel sheet.

The expected result:

Please note this is the expected format.

enter image description here

The expected mail body contains both hyperlink and a table.

Note: I need to get values from Excel because the values in the table keep changing.

not clear from your description: you want to insert mail content into an excel worksheet, or the other way round? is the "screenshot" the current working version, or what it should look like once it is done? do you want a html body/multipart message/attachment? — Cee McSharpface, Jun 22 '17 at 10:43
The attached mail is the expected format. How to achieve that from outlook vba code? — Sai, Jun 22 '17 at 10:50
have a look at [this answer](https://stackoverflow.com/a/29624972/1132334), is it what you are looking for? — Cee McSharpface, Jun 22 '17 at 10:55
@dlatikay, thanks for the reference, but unfortunately this is not the one I wanted. — Sai, Jun 22 '17 at 10:59
@CLR, the code above retrives all the values mentioned in the excel sheet like To, Cc,subject. And body with signature. Please note the code works absolutely fine for body that contains only text. But, as per my requirement I need to send a hyperlink and a table along with text as body of the mail. — Sai, Jun 22 '17 at 13:39
So you want to send HTML instead of plain text..? Assuming you know how to craft HTML, then you need to use `.BodyHTML = ` instead of `.Body = `. (You'll also need to set `.BodyFormat = olFormatHTML` beforehand) — CLR, Jun 22 '17 at 13:54
Yeah, that is fine. Using htmlbody the mail.body can be coded directly in the outlook VBA. But the mail body is not static. The data in the table keeps changing. That is the reason why I need to get the HTML at from the linked Excel sheet . So that each time there is a change in the content of the mail body, I don't have to make changes in the code rather update the excel sheet. Hope it the requirement is clear now! — Sai, Jun 22 '17 at 14:49
not quite. do you want to render parts of a spreadsheet as html, so it looks similar in the mail? or is there a cell in the excel worksheet that *contains html*? presuming the first, write a html file and test it in a browser until it looks like it should, then use that as a template where you inject the dynamic parts from excel data. keep in mind that not all mail clients support the same subset of html tags, and usually less than a typical browser. — Cee McSharpface, Jun 22 '17 at 21:58
@dlatikay, yeah correct I need to inject HTML from Excel into mail body. And I don't know how to do it. — Sai, Jun 23 '17 at 11:44

jsotola · Accepted Answer · 2017-07-02T21:56:13.413

please try this

Sub testEmail()

    ' these constants are necessary when using "late binding"
    ' determined by using "early binding" during initial development

    Const wdTextureNone = 0
    Const wdColorAutomatic = &HFF000000              ' -16777216
    Const wdWord9TableBehavior = 1
    Const wdAlignParagraphCenter = 1
    Const wdAutoFitContent = 1
    Const wdAutoFitWindow = 2
    Const wdAutoFitFixed = 0

    Dim outMail As Outlook.MailItem
    Set outMail = Application.CreateItem(olMailItem) ' 0
    outMail.Display (False)                          ' modeless

'   Dim wd As word.Documents                         ' early binding ... requires reference to "microsoft word object library"
    Dim wd As Object                                 ' late binding  ... no reference required
    Set wd = outMail.GetInspector.WordEditor

    wd.Paragraphs.Space2                             ' double spaced
    wd.Paragraphs.SpaceAfter = 3
    wd.Paragraphs.SpaceBefore = 1

    wd.Range.InsertAfter "Hi Team!" & vbCrLf
    wd.Range.InsertAfter "Please update the portal with the latest information." & vbCrLf
    wd.Range.InsertAfter "The portal link:" & vbCrLf

'   wd.Words(wd.Words.Count).Select                 ' debug

    wd.Hyperlinks.Add Anchor:=wd.Words(wd.Words.Count), _
            Address:="http://google.com", SubAddress:="", _
            ScreenTip:="this is a screen ttip", TextToDisplay:="link text to display"

    wd.Range.InsertAfter vbCrLf

'   wd.Words(wd.Words.Count).Select                 ' debug

    wd.Range.InsertAfter "The team details are mentioned below:" & vbCrLf

    wd.Tables.Add Range:=wd.Words(wd.Words.Count), NumRows:=3, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed  ' 1,0

'   Dim tabl As word.Table                           ' early binding ... requires reference to "microsoft word object library"
    Dim tabl As Object                               ' late binding  ... no reference required
    Set tabl = wd.Tables(1)


    tabl.Cell(1, 1).Range.Text = "Team"
    tabl.Cell(1, 2).Range.Text = "Head"

    tabl.Cell(2, 1).Range.Text = "litmus"
    tabl.Cell(2, 2).Range.Text = "Sam"

    tabl.Cell(3, 1).Range.Text = "sigma"
    tabl.Cell(3, 2).Range.Text = "tony"

    wd.Range.InsertAfter vbCrLf & "regards" & vbCrLf

' --------------------------------------------------------------------
' configure the table
' --------------------------------------------------------------------

'    wd.Tables(1).Columns(1).Cells(1).Select         ' debug
'    wd.Tables(1).Columns(1).Cells(2).Select
'    wd.Tables(1).Columns(1).Cells(3).Select

    tabl.Style = "Table Grid"
    tabl.ApplyStyleHeadingRows = True
    tabl.ApplyStyleLastRow = False
    tabl.ApplyStyleFirstColumn = True
    tabl.ApplyStyleLastColumn = False
    tabl.ApplyStyleRowBands = True
    tabl.ApplyStyleColumnBands = False

    tabl.Shading.Texture = wdTextureNone                       ' 0
    tabl.Shading.ForegroundPatternColor = wdColorAutomatic     ' -16777216 (hex: &HFF000000)
    tabl.Shading.BackgroundPatternColor = wdColorAutomatic
    tabl.Rows(1).Shading.BackgroundPatternColor = RGB(200, 250, 200)  ' table header colour

'    tabl.Shading.BackgroundPatternColor = wdColorRed

'    tabl.Range.Select     ' debug

    tabl.Range.Paragraphs.Space1    ' single spaced
    tabl.Range.Paragraphs.SpaceAfter = 0
    tabl.Range.Paragraphs.SpaceBefore = 0


    tabl.Range.Font.Size = 14
    tabl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter  ' 1

    tabl.Rows(1).Range.Font.Size = 18
    tabl.Rows(1).Range.Bold = True


'   tabl.AutoFitBehavior (wdAutoFitContent)  ' 1
'   tabl.AutoFitBehavior (wdAutoFitWindow)   ' 2
    tabl.AutoFitBehavior (wdAutoFitFixed)    ' 0
    tabl.Columns(1).Width = 100
    tabl.Columns(2).Width = 100

    Set tabl = Nothing
    Set wd = Nothing
    Set outMail = Nothing
End Sub

Insert text, hyperlink and table in the mail body

1 Answers1