Sub Create_Email()
'Copy the desired range as a picture
Dim ws As Worksheet, rg As Range
Set ws = ThisWorkbook.Sheets("Audit Sheet")
Set rg = ws.Range("B2:L19")
rg.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'Set the date string to be used in the email
Dim strDate As String
strDate = Range("J2")
strname = Range("D2")
'Create a new Outlook email
Dim olApp As Object, olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0) 'olMailItem
With olMail
.SentOnBehalfOfName = ""
.To = Range("D3")
.CC = Range("D5")
.BCC = ""
.Subject = "Audit Report (" & strDate & ")"
.Display
' paste the picture into the body, followed by a basic signature
Dim wordDoc As Variant
Set wordDoc = .GetInspector.WordEditor
With wordDoc.Range
.PasteSpecial DataType:=4 'wdPasteBitmap
With wordDoc.InlineShapes(1)
.ScaleHeight = 120
End With
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter "Thank you,"
.InsertParagraphAfter
.InsertAfter "John Smith"
End With
' apply formatting and insert greeting before the picture
.HTMLBody = "<BODY style = font-size:11pt; font-family:Calibri;>" & _
"<p><b>Good Day Mr/Ms " & strname & "</b></p>" & _
"<p>Please find below Audit Report. </p>" & .HTMLBody
End With
