Be the first user to complete this post

  • 0
Add to List

Excel-VBA : Send Unique Images Embedded to Mail Body, With Every Mail From MS Outlook using Excel.

Many a times you need a scenario when you want to send a mail on the daily basis and every new mail contain new image embedded to the mail body, say for example you want to send Good morning message with new image every day.

I would recommend that you must read Send a Simple Mail From MS Outlook Using Excel and how to send Embedded to the mail body from MS Outlook using Excel to understand the basics first if you are new to this.

So how would you do that, there are many different ways to accomplish this, the strategy which I have used here is

  • Store all the Images in a folder.
  • First time you run your macro, the program will connect to the image folder, take the first image and use it and mark that image as used in our excel.
  • Next time when you run the macro, it will see which image is not marked as used, use that. see this picture below.
Used Images

Complete Code:

Sub sumit()
Dim mainWB As Workbook
Dim SendID
Dim Subject
Dim Body
Dim olMail As MailItem

Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set Doc = olMail.GetInspector.WordEditor
Dim oAttach As Outlook.Attachment

Set mainWB = ActiveWorkbook

SendID = mainWB.Sheets("Mail").Range("B1").Value
CCID = mainWB.Sheets("Mail").Range("B2").Value
Subject = mainWB.Sheets("Mail").Range("B3").Value
Body = mainWB.Sheets("Mail").Range("B4").Value
With olMail
.To = SendID
If CCID <> "" Then
End If
.Subject = Subject
strFilepath = AddImage(strFile)
MsgBox strFile & "   " & strFilepath
'add the image in hidden manner, position at 0 will make it hidden
.Attachments.Add strFilepath, olByValue, 0
'Now add it to the Html body using image name
'change the src property to 'cid:your image filename'
'it will be changed to the correct cid when its sent.
.HTMLBody = .HTMLBody & "<br><B>Todays Image:</B><br>" _
& "<img src='cid:" & Trim(strFile) & "'" & "width='500' height='200'><br>" _
& "<br>Best Regards, <br>Sumit</font></span>"
End With

MsgBox ("you Mail has been sent to " & SendID)

End Sub
Function AddImage(strFile)
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
Dim blnFound
Folderpath = mainWorkBook.Sheets("Setting").Range("H3").Value
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files

For Each fls In listfiles
For i = 1 To NoOfFiles + 5
rowNo = i + 1
cellVal = mainWorkBook.Sheets("Setting").Range("A" & rowNo).Value
If (cellVal <> "") Then
' checking if image is used
If (StrComp(Trim(cellVal), Trim(fls.Name), vbTextCompare) = 0) Then
Exit For
End If
'if you are here, that means you have found the new image to use
mainWorkBook.Sheets("Setting").Range("A" & rowNo).Value = Trim(fls.Name)
strCompFilePath = Folderpath & "\" & Trim(fls.Name)
AddImage = strCompFilePath
strFile = Trim(fls.Name)
blnFound = True
Exit For
End If
If (blnFound) Then
Exit For
End If
End Function

Send Mail
Send Mail
Different Images in New Mail
Different Images in New Mail

Also Read:

  1. VBA-Excel: Working with Bookmarks- Insert text After Bookmark
  2. VBA-Excel: Maximize, Minimize and Restore Internet Explorer (IE) using Microsoft Excel.
  3. VBA-Excel: Update XML File
  4. VBA-Excel: Convert Numbers (Rupees) into Words OR Text - Updated Till 1000000 Crore With Decimal Numbers
  5. VBA-Excel: Format the Existing Table in a Word document