I'm trying to paste a picture from a range within excel, which I've found a solution for, but for some reason it keeps removing my signature. I have tried to use vbNewline, .body, and one other thing, but for some reason none of them are working or I'm inserting them in the incorrect place.
Sub SendEmail()
'This macro use the function named : CopyRangeToJPG
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim MakeJPG As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'If you want to include a message in body of email
'strbody = ""
'Create JPG file of the range
'Only enter the Sheet name and the range address
MakeJPG = CopyRangeToJPG("Sheet1", "A2:P50")
If MakeJPG = "" Then
MsgBox "Something went wrong, can't create email"
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
End If
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "My Company"
.BodyFormat = olFormatHTML
.Display
End With
With OutMail
.To = "Customer"
.cc = ""
.BCC = ""
.Subject = "Customer - " & Date + 1
.Attachments.Add MakeJPG, 1, 0
'Note: Change the width and height as needed
.HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg"" width=750 height=700></html>"
.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
Dim PictureRange As Range
With ActiveWorkbook
On Error Resume Next
.Worksheets(NameWorksheet).Activate
Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
If PictureRange Is Nothing Then
MsgBox "Sorry this is not a correct range"
On Error GoTo 0
Exit Function
End If
PictureRange.CopyPicture
With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
End With
.Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
End With
CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
Set PictureRange = Nothing
End Function
" & strbody & "