Sunday, January 26, 2014

Send HTML email with embedded Images

The following article explains how to send an email in VBA with embedded images in the body. The code works with all Microsoft Office Suite (including Office 2013).

Let's consider an Excel file with a 'Dashboard' sheet as this screenshot :




The code detailed after automatically creates a 'ready to send' email in outlook :



First we create an outlook mail object, then, we write the mail body (in html). Please note following points :
    - embedded images must be save on your computer (as a jpg file or png file) ;
    - Since outlook 2013, embedded images must be attached to the email as well.

Sub sendMail()
        Application.Calculation = xlManual
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Dim TempFilePath As String
        
        'Create a new Microsoft Outlook session
        Set appOutlook = CreateObject("outlook.application")
        'create a new message
        Set Message = appOutlook.CreateItem(olMailItem)
          
        
        With Message
            .Subject = "My mail auto Object"
    
            .HTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello,<br ><br >The weekly dashboard is available " _
                & "<br>Find below an overview :<BR>"
               
            'first we create the image as a JPG file
            Call createJpg("Dashboard", "B8:H9", "DashboardFile")
            'we attached the embedded image with a Position at 0 (makes the attachment hidden)
            TempFilePath = Environ$("temp") & "\"
            .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0
               
            'Then we add an html <img src=''> link to this image
            'Note than you can customize width and height - not mandatory
               
            .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
                & "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _
                & "<br>Best Regards,<br>Ed</font></span>"
                
            .To = "contact1@email.com; contact2@email.com"
            .Cc = "contact3@email.com"
                
            .Display
            '.Send
        End With
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        Application.Calculation = xlCalculationAutomatic
    End Sub

You need to create createJpg function which transform a range into a jpg file.

Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Sub

You can download my template file here (untick Use our download manager and get recommended downloads)

Sunday, December 29, 2013

How do I retrieve data from another Excel file without opening it ?

Let's consider a 'Source file' in the same folder as my Excel Macro.


Let's say that data we want to retrieve is a table made of 5 columns in the first sheet of 'Source file'.

First, we need to create a 'Data retrieval' sheet in 'My Macro.xlsm' file. Then, we can retrieve 'Source file.xlsx' data without opening it with the following VBA code :

Set appxl = CreateObject("Excel.application")
Dim myfile As Window
Dim currentSheet As Worksheet
Dim lastRow As Double
Dim sourceFileName As String

sourceFileName = "Source File.xlsx"

'Open Source File.xlsx
With appxl
    .Workbooks.Open ActiveWorkbook.Path & "\" & sourceFileName
    .Visible = False
End With
 
'Get first sheet data
Set myfile = appxl.Windows(sourceFileName)
myfile.Activate
Set currentSheet = appxl.Sheets(1)

'Past the table in my current Excel file
lastRow = currentSheet.Range("A1").End(xlDown).Row
Sheets("Data retrieval").Range("A1:E" & lastRow) = currentSheet.Range("A1:E" & lastRow).Value

'Close Source File.xlsx
appxl.Workbooks(sourceFileName).Close

As you can see, we actually open the source file with a false visible status and then we close it.