Question Sending Email with Bitmap

Hi Roller, im creating a macro to send out email but i wanted to paste the text into bitmap, here is my code below. can you help me with this? Current code is pasting as picture.

Sub email_interval()
'
' Macro1 Macro

'

MsgBox Worksheets("Summary").Range("B81").Value


Dim OutApp As Object
Dim OutMail As Object
Dim toDL, ccDL, sSubject As String
Sheets("Summary").Select
toDL = Sheets("Summary").Range("B84").Value
ccDL = Sheets("Summary").Range("B85").Value
sSubject = Sheets("Summary").Range("B86").Value


With Application
.EnableEvents = False
.ScreenUpdating = False



End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next

With OutMail
.sentonbehalfofname = Sheets("Summary").Range("B83").Value
.To = toDL
.CC = ccDL
.BCC = ""
.Subject = sSubject
.Attachments.Add Sheets("Summary").Range("B77").Value & "\" & Range("A79").Value & ".xlsm"

.display 'or use .Display

End With


' For Salutation

Sheets("Summary").Select
Range("B89").Select
Selection.Copy
OutMail.display
SendKeys "~", 8
SendKeys "^v", 8
SendKeys "~", 8

Sheets("Summary").Select
Range("B95").Select
Selection.Copy
OutMail.display
SendKeys "~", 8
SendKeys "^v", 8
SendKeys "~", 8

Sheets("Summary").Select
Range("XEO52").Select
Selection.Copy
OutMail.display
SendKeys "~", 8
SendKeys "^v", 8

Sheets("Summary").Select
Range("C12").CurrentRegion.Select

---

Im guessing this line should be changed. Need help
Selection.CopyPicture
OutMail.display
SendKeys "~", 8
SendKeys "(^%v)", 8
SendKeys "~", 8

If (Worksheets("Performance").Range("DS2") = True) Then
MsgBox "Please dont forget to Switch the Interval/EOD on Cell C1."
End If

With Application
.EnableEvents = True
.ScreenUpdating = True
.CutCopyMode = False
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

The body of an Outlook email is actually a Word document called Inspector, if you set reference to the inspector you can copy and paste into it directly. Something like the below:

Sub eml()
Dim oa As Outlook.Application
Set oa = New Outlook.Application
Dim em As Outlook.MailItem
Set em = oa.CreateItem(olMailItem)

Dim ins As Outlook.Inspector
Set ins = em.GetInspector

Dim objDoc As Word.Document
Dim objSel As Word.Selection
em.Display
Set objDoc = ins.WordEditor
Set objSel = objDoc.Windows(1).Selection

Selection.CopyPicture ' gets from Excel what ever you have selected as image

objSel.Paste ' paste into the body of the email

End Sub

NOTE: If you reference Outlook and Word from Excel like above 'early binding' you must select the references for Outlook and Word from the VBA editor in Excel menu. OR you can use late binding and dim them as Objects and set them like you did like CreateObject("Outlook.Application").

Hi Roller, thanks for the reply. Would this paste all as Bitmap? what i wanted to do was only a part of the report as bitmap.

Am i doing this correct?

Sub email_interval()

'
' Macro1 Macro

'

MsgBox Worksheets("Summary").Range("B81").Value

Dim oa As Outlook.Application
Set oa = New Outlook.Application
Dim em As Outlook.MailItem
Set em = oa.CreateItem(olMailItem)

' Dim OutApp As Object
' Dim OutMail As Object
Dim toDL, ccDL, sSubject As String
Sheets("Summary").Select
toDL = Sheets("Summary").Range("B84").Value
ccDL = Sheets("Summary").Range("B85").Value
sSubject = Sheets("Summary").Range("B86").Value


With Application
.EnableEvents = False
.ScreenUpdating = False



End With

Dim ins As Outlook.Inspector
Set ins = em.GetInspector

Dim objDoc As Word.Document
Dim objSel As Word.Selection
em.Display
Set objDoc = ins.WordEditor
Set objSel = objDoc.Windows(1).Selection


' Set OutApp = CreateObject("Outlook.Application")
' Set OutMail = OutApp.CreateItem(0)


On Error Resume Next

With OutMail
.sentonbehalfofname = Sheets("Summary").Range("B83").Value
.To = toDL
.CC = ccDL
.BCC = ""
.Subject = sSubject
.Attachments.Add Sheets("Summary").Range("B77").Value & "\" & Range("A79").Value & ".xlsm"

.Display 'or use .Display

End With


' For Salutation

Sheets("Summary").Select
Range("B89").Select
Selection.Copy
OutMail.Display
SendKeys "~", 8
SendKeys "^v", 8
SendKeys "~", 8

Sheets("Summary").Select
Range("B95").Select
Selection.Copy
OutMail.Display
SendKeys "~", 8
SendKeys "^v", 8
SendKeys "~", 8

Sheets("Summary").Select
Range("XEO52").Select
Selection.Copy
OutMail.Display
SendKeys "~", 8
SendKeys "^v", 8

Sheets("Summary").Select
Range("C12").CurrentRegion.Select
Selection.CopyPicture
OutMail.Display
SendKeys "~", 8
SendKeys "(^%v)", 8
SendKeys "~", 8

If (Worksheets("Performance").Range("DS2") = True) Then
MsgBox "Please dont forget to Switch the Interval/EOD on Cell C1."
End If

With Application
.EnableEvents = True
.ScreenUpdating = True
.CutCopyMode = False
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

It doesn't look correct to me. Avoid using sendKeys all together, using this methods is not the best approach, you are asking for trouble and there are simpler ways.

you can use the email.HTMLbody = <p> balhhh</p> to craft a message with formatting.

OR email.body = blahhh to get plain text into your email.

Or use the Inspector object to paste directly like in the example I provided you.