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.
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