VBA - Email/Embedd Pictures from Excel into Outlook

[Harlow]

Good day!

I have a VBA that will generate an email and embed pictures from Excel into my Outlook. The Macro runs great. However, every one of my images has a line across the top. Its very annoying. I have adjusted the Range on the excel file with no success. If I change the Macro to copy the picture/Chart as xlPicture vs xlBitmap, then there is a boarder around the entire image.

Help! How do I remove the line across the top?

When I view the images in my dump folder, there is no line. Or not that im able to see.

Here is the basic VBA

Sub JFY_Email()

Dim Y
Y = MsgBox("Send JFY Overview?", vbYesNo)
If Y = vbNo Then
MsgBox "PLS TRY AGAIN"
Exit Sub
Else
End If
Dim wb As ThisWorkbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("JFY Overview")
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Set rng = Range("JFY")
Set rng2 = Range("JFY2")
Set rng3 = Range("JFY3")
Workbooks.Add
Dim CH As Chart
Dim CH2 As Chart
Dim CH3 As Chart
Set CH = Charts.Add 'THIS WILL ADD THE CHART
CH.Location xlLocationAsObject, "Sheet1"
Set CH = ActiveChart
ActiveChart.Parent.Name = "JFY"
ActiveSheet.ChartObjects("JFY").Height = rng.Height
ActiveSheet.ChartObjects("JFY").Width = rng.Width
rng.CopyPicture xlScreen, xlBitmap
CH.Paste
CH.Export "C:\Users\...JFY.png"

Set CH2 = Charts.Add 'THIS WILL ADD THE CHART
CH2.Location xlLocationAsObject, "Sheet1"
Set CH2 = ActiveChart
ActiveChart.Parent.Name = "JFY2"
ActiveSheet.ChartObjects("JFY2").Height = rng2.Height
ActiveSheet.ChartObjects("JFY2").Width = rng2.Width
rng2.CopyPicture xlScreen, xlBitmap
CH2.Paste
CH2.Export "C:\Users\...JFY2.png"


Set CH3 = Charts.Add 'THIS WILL ADD THE CHART
CH3.Location xlLocationAsObject, "Sheet1"
Set CH3 = ActiveChart
ActiveChart.Parent.Name = "JFY3"
ActiveSheet.ChartObjects("JFY3").Height = rng3.Height
ActiveSheet.ChartObjects("JFY3").Width = rng3.Width
rng3.CopyPicture xlScreen, xlBitmap
CH3.Paste
CH3.Export "C:\Users\...JFY3.png"

'Set up outlook
Dim OApp As Object, OMail As Object, signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
reportdate = Format(wb.Sheets("JFY Overview").Range("UpgradeDate"), "mmddyyyy")

With OutMail
.Display
End With
signature = OutMail.HTMLBody

strbody = "<p style='font-family:Sans Regular;font-size:14.5'>Greetings,<br><br>" & _
"Generic Email Message<p>"


'Create message
On Error Resume Next

With OutMail
'.To = "me@me.com" 'Insert required address here ########
'.CC = ""
.BCC = ""
.Subject = "name of email"
.HTMLBody = strbody & "<br>" & _
"<img src='C:\Users\...JFY.png'/img><br>" & _
"<img src='C:\Users\...JFY2.png'/img>" & _
"<img src='C:\Users\...JFY3.png'/img>" & _
signature
'.Body = "Put your body content here" '& vbCr & "Best regards, etc." & vbCr
.Display 'Use only during debugging ##############################
'.Send 'Uncomment to auto send e-mail ##############################
End With
'Delete any temp files created
Kill Workbooks("Book1")

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[Harlow]

Bump

Any ideas? It also seems that the xlBitmap is formatting the image with a white boarder. Meaning, I am copying an extra column and row around my data, yet some of the image is being cut off.

Thoughts?