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 sce­nario when you want to send a mail on the daily basis and every new mail con­tain new image embed­ded to the mail body, say for exam­ple you want to send Good morn­ing mes­sage with new image every day.

I would rec­om­mend that you must read Send a Sim­ple Mail From MS Out­look Using Excel and how to send Embed­ded to the mail body from MS Out­look using Excel to under­stand the basics first if you are new to this.

So how would you do that, there are many dif­fer­ent ways to accom­plish this, the strat­egy which I have used here is

  • Store all the Images in a folder.
  • First time you run your macro, the pro­gram will con­nect 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 pic­ture below.

Used Images

Com­plete 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

Dif­fer­ent 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 appli­ca­tion defined error
    please advice

    thanks,
    Fauzie

Leave a Reply

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

%d bloggers like this: