I found this code below in the internet, this one you can see that it can pick up range with its image, i tried using the technique below into the above code, but i failed. I appreciate your help.
Code:Private Function RngToEmail(rng As Range, eTo As String, eSubject As String) Dim wbThis As Workbook, wbNew As Workbook Dim tempFileName As String, imgName As String, newPath As String '~~> Do not change "Myimg". This will be used to '~~> identify the images Dim imgPrefix As String: imgPrefix = "Myimg" '~~> This is the temp html file name. '~~> Do not change this as when you publish the '~~> html file, it will create a folder Temp_files '~~> to store the images Dim tmpFile As String: tmpFile = "Temp.Htm" Set wbThis = Workbooks(rng.Parent.Parent.Name) Set wbNew = Workbooks.Add '~~> Copy the relevant range to new workbook rng.Copy wbNew.Worksheets("Sheet1").Range("A1") newPath = wbThis.Path & "\" tempFileName = newPath & tmpFile '~~> Publish the image With wbNew.PublishObjects.Add(xlSourceRange, _ tempFileName, "Sheet1", rng.Address, xlHtmlStatic, _ imgPrefix, "") .Publish (True) .AutoRepublish = True End With '~~> Close the new file without saving wbNew.Close (False) '~~> Read the html file in a string in one go Dim MyData As String, strData() As String Dim i As Long Open tempFileName For Binary As #1 MyData = Space$(LOF(1)) Get #1, , MyData Close #1 strData() = Split(MyData, vbCrLf) '~~> Loop through the file For i = LBound(strData) To UBound(strData) '~~> Here we will first get the image names If InStr(1, strData(i), "Myimg_", vbTextCompare) And InStr(1, strData(i), ".Png", vbTextCompare) Then '~~> Insert actual path to the images strData(i) = Replace(strData(i), "Temp_files/", newPath & "Temp_files\") End If Next i '~~> Rejoin to get the new html string MyData = Join(strData, vbCrLf) '~~> Create the Email Dim OutApp As Object, OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = eTo .Subject = eSubject '~~> Set the body .HTMLBody = MyData '~~> Show the email. Change it to `.Send` to send it .Display End With '~~> Delete the temp file name Kill tempFileName End Function




Reply With Quote
Bookmarks