Show Buttons
Share On Facebook
Share On Twitter
Share On Google Plus
Share On Linkdin
Share On Reddit
Contact us
Hide Buttons

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 CCID
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
      .CC = CCID
    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>"
    .Display
    .Send
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
            Else
'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
        Next
        If (blnFound) Then
            Exit For
        End If
    Next
mainWorkBook.Save
End Function

Send Mail

Send Mail

Different Images in New Mail

Different Images in New Mail

You may also like...

1 Response

  1. Fauzie Bachri says:

    Hi,

    i always receive an error in this line Set Doc = olMail.GetInspector.WordEditor application defined error
    please advice

    thanks,
    Fauzie

Leave a Reply

Your email address will not be published. Required fields are marked *

%d bloggers like this: