3

I have a worksheet with given data,
enter image description here

I need to email the data using Microsoft Outlook in the required format for a specific date.

Say the date is 05 Jan 2015.
enter image description here

This is how the email should look,
enter image description here

The code is written in the modules of the Excel 2007 workbook,

Public Function FormatEmail(Sourceworksheet As Worksheet, Recipients As Range, CoBDate As Date)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim rows As Range

    On Error GoTo FormatEmail_Error

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    For Each rows In Recipients.Cells.SpecialCells(xlCellTypeConstants)

        If rows.value Like "?*@?*.?*" Then

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .To = rows.value
                .Subject = "Reminder"
                .Body = "Hi All, " & vbNewLine & _
                         vbNewLine
                .display
            End With
            On Error GoTo 0

            Set OutMail = Nothing

        End If

    Next rows

    On Error GoTo 0
    Exit Function

FormatEmail_Error:

    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatEmail of Module modOutlook"

End Function
Community
  • 1
  • 1
Manivannan KG
  • 371
  • 1
  • 9
  • 24

2 Answers2

7

If you want to create nicely formatted Outlook emails then you need to generate emails with formatting. Pure text-based-emails are evidently not sufficient and hence you must be looking for HTML formatted emails. If that's the case you probably aim to dynamically create HTML code with your VBA to mimic the nice visual representation of Excel.

Under the following link http://www.quackit.com/html/online-html-editor/ you'll find an online HTML editor which allows you to prepare a nicely formatted email and then shows you the HTML code which is necessary to get this formatting. Afterwards you just need to set in VBA the email body to this HTML code using

.HTMLBody = "your HTML code here"

instead of

.Body = "pure text email without formatting"

If that is not sufficient and you want to copy / paste parts of your Excel into that email then you'll have to copy parts of your Excel, save them as a picture, and then add the picture to your email (once again using HTML). If this is what you want then you'll find the solution here: Using VBA Code how to export excel worksheets as image in Excel 2003?

Community
  • 1
  • 1
Ralph
  • 9,284
  • 4
  • 32
  • 42
  • This is right and partial. I have provided the full code. This website do help http://www.rondebruin.nl/win/s1/outlook/mail.htm – Manivannan KG Mar 08 '15 at 23:31
1

Here is the answer for that serves the purpose. The html body is build using string builder concept and the email is formed as required(Altered the sub of email from the post). This is working fine.

Public Function FormatEmail(Sourceworksheet As Worksheet, CoBDate As Date, FinalRatioLCR As Variant, FinalRatioAUD As Variant)

Dim OutApp As Object
Dim OutMail As Object
Dim eMsg As String

Dim ToRecipients As String

   On Error GoTo FormatEmail_Error

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

Dim Matrix2_1, Matrix2_2, Matrix2_3, Matrix3_1 As String
Dim FinanceAllCurrency, AllCurrencyT1, AllCurrencyT0, AllCurrencyAUD As Double

'FinanceAllCurrency = FinalRatioLCR
AllCurrencyT1 = 10.12
AllCurrencyT0 = 20.154
'AllCurrencyAUD = FinalRatioAUD
Matrix2_1 = "<td>" & FinalRatioLCR & "</td>"
Matrix2_2 = "<td>" & AllCurrencyT1 & "</td>"
Matrix2_3 = "<td>" & AllCurrencyT0 & "</td>"
Matrix3_1 = "<td>" & FinalRatioAUD & "</td>"

eMsg = "<head><style>table, th, td {border: 1px solid black; border-collapse:" & _
        "collapse;}</style></head><body>" & _
        "<table style=""width:50%""><tr>" & _
        "<th bgcolor=""#D8D8D8"">LCR</th><th bgcolor=""#D8D8D8"">Finance</th>" & _
         "<th bgcolor=""#D8D8D8"">Desk T+1</th><th bgcolor=""#D8D8D8"">Desk T+0</th></tr><tr>" & _
        "<td>All Currency</td>" & Matrix2_1 & Matrix2_2 & _
         Matrix2_3 & _
        "</tr><tr><td>AUD Only</td>" & Matrix3_1 & "<td>-</td>" & _
        "<td> &nbsp; &nbsp;  -  &nbsp;</td></tr></Table></body>"


ToRecipients = GetToRecipients

   Set OutMail = OutApp.CreateItem(0)
   
  
      With OutMail
                .To = ToRecipients
                .Subject = " Report -" & CoBDate
                .HTMLBody = "Hi All, " & "<br></br><br></br><br></br><br></br>" & _
                           eMsg
                .display
                
       End With
       
     On Error GoTo 0
     
     Set OutMail = Nothing

   On Error GoTo 0
   Exit Function

FormatEmail_Error:

    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatEmail of Module modOutlook"

End Function

Recipients adress is dynamically retrieved from a range.

Private Function GetToRecipients() As String
Dim rngRows As Range
Dim returnName As String

For Each rngRows In shMapping.Range(MAPPING_EMAIL_RECIPIENTS).rows

If Len(returnName) = 0 Then
    returnName = rngRows.Cells(, 2).value2
ElseIf Len(rngRows.Cells(, 2).value2) > 0 Or rngRows.Cells(, 2).value2 Like "?*@?*.?*" Then
    returnName = returnName & ";" & rngRows.Cells(, 2).value2
End If

Next
GetToRecipients = returnName
End Function
Community
  • 1
  • 1
Manivannan KG
  • 371
  • 1
  • 9
  • 24