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.
Dim mainWB As Workbook
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
.To = SendID
If CCID <> "" Then
.CC = CCID
.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>"
MsgBox ("you Mail has been sent to " & SendID)
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
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
‘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
If (blnFound) Then