embed saved image to gmail body

[ajaypal_sp]

HI,


I want to embed saved image in Gmail body. I saved excel range as image. But I could not embed saved image into Gmail. Please go through the code. help me to solve this issue.

Sub idea_Mail()Dim i, lr1, l As Long
Dim ws, sh, sht As Worksheet
Dim wbk, bk As Workbook
Dim folder, pw, dt, fname As String
Dim myMail As CDO.Message
Dim ebody As String
Dim f As Object, fso As Object, flder As Object
Dim MyPath As String
On Error Resume Next
MkDir "c:\users\" & Environ("username") & "\desktop\shiva"
On Error Resume Next
Kill MyPath
Set wb = ThisWorkbook
Set sh = wb.Worksheets("data")
Set sht = wb.Worksheets("names")
wb.Worksheets(sh).Activate
wb.Sheets(sh).ShowAllData
l = sh.Cells(Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Worksheets("Data").Activate
'wb.Sheets(sh).Range("o1:o" & l).RemoveDuplicates Columns:=1, Header:=xlYes
lr1 = sht.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr1
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Data").Range("a4").AutoFilter Field:=1, Criteria1:=sht.Cells(i, 1).Value
ThisWorkbook.Worksheets("Data").Range("a1:z" & l + 3).SpecialCells(xlCellTypeVisible).Copy
    ActiveSheet.Pictures.Paste.Select
    Application.CutCopyMode = True
    Set sht = ThisWorkbook.ActiveSheet
    sht.DrawingObjects.Select
    Selection.Copy
    sht.Pictures.Select
    Set sh = sht.Shapes(sht.Shapes.Count)
    Set tmpChart = Charts.Add
    tmpChart.ChartArea.Clear
    tmpChart.Name = "PicChart" & (Rnd() * 10000)
    Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
    tmpChart.ChartArea.Width = sh.Width
    tmpChart.ChartArea.Height = sh.Height
    tmpChart.Parent.Border.LineStyle = 0
    'Paste range as image to chart
    sh.Copy
    tmpChart.ChartArea.Select
    tmpChart.Paste


fname = Worksheets("names").Cells(i, 1).Value
      tmpChart.Export Filename:=Environ("UserProfile") & "\desktop\shiva\" & fname & ".png", FilterName:="png"
    sht.DrawingObjects.Delete
    Set rng = Nothing
Set wb = ThisWorkbook
pw = "XXXXXXX"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set myMail = New CDO.Message


myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True


myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1


myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"


myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465


myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2


myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "abc@gmail.com"




myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pw


myMail.Configuration.Fields.Update


'lr = ws.Cells(Rows.Count, 15).End(xlUp).Row


rng_1 = ThisWorkbook.Worksheets("names").Range("a1:b100")
ename = ThisWorkbook.Sheets(sh).Cells(i, 15).Value
empemail = Application.WorksheetFunction.VLookup(ename, rng_1, 2, 0)


ebody = "" & "Please find the below Data" & "
" _
& "[IMG]https://www.mrexcel.com/forum/""c:\users\ajay" & "\desktop\shiva\" & fname & ".png’>" & "width=’500[/IMG]
" & "
" & "Regards" & "
" & "Team IBS"
With myMail
.Subject = "February Goals!!!"
.From = "abc@gmail.com"
.To = "xyz@gmail.com"
.BCC = ""
.HTMLBody = ebody
.Send
End With
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("All Mail's has been sent")
Set myMail = Nothing


End Sub

thank you in advance.


regards
ajay