VBA- Copy & Paste Range into Outlook as a Picture

Trae1170

New Member
Joined
Apr 11, 2024
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hello everyone, I have very, very limited knowledge of VBA and I generally just find code does something similar to what I need and try to modify it it to work for me. Not for this one though lol .
In this instance I have a button in a report summary, I would like to click the button "Send Email to Team" and have it highlight and copy a range from the report, open a new Outlook email, enter the "To", "subject" and Text in body and then paste the selection as a picture.

I have the code that copies the range, automatically opens a new Outlook email for me and enters the "To" address, Subject and some text into the email body based on text coming from specific cells in a report.

What I still need is how to Paste the range from the report into the email just after the text in the Body. I would like it to take the range and convert it to a picture if possible just so it keeps it formatting and can be easily resized if needed.
I do not want it to send the email, just generate it with the picture so additional info can be added if need prior to Sending the email.

I am using Office 360 Enterprise - Excel version 2308
Here is my current code and a snapshot of my spreadsheet.

Sub Sendemail()

Range("A10:L60").Select
Selection.Copy

Dim OutApp As Object, OutMail As Object

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

With OutMail
.To = Range("B1").Value
.Subject = Range("B2").Value
.Body = Range("B3").Value

.Display
' .Body = Selection.Paste
' Selection.Paste

End With

End Sub

' Set OutMail = Nothing



Thank you in Advance,
 

Attachments

  • 2024-04-11_14-08-48.jpg
    2024-04-11_14-08-48.jpg
    177.8 KB · Views: 80
  • 2024-04-11_14-08-48.jpg
    2024-04-11_14-08-48.jpg
    177.8 KB · Views: 82

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Try the following...

VBA Code:
With OutMail
    .Display
    .To = Range("B1").Value
    .Subject = Range("B2").Value
    With .GetInspector.WordEditor
        '.Application.Selection.EndKey Unit:=6 'wdStory (optional)
        '.Application.Selection.typeparagraph 'new line/carriage return (optional)
        '.Application.Selection.typeparagraph 'new line/carriage return (optional)
        .Application.Selection.Paste
    End With
End With

Hope this helps!
 
Upvote 0
Thank you for the response but I have since found a solution.
Thank you again.
 
Upvote 0
That's great, glad you were able to find a solution, cheers!
 
Upvote 0
It would be "greater" if you showed your solution for people that come here with the same problem. It is not nice for them to finally find a post that they will think has an answer to their problem and find that the answer is "I have since found a solution" but no solution offered. I am sure you will offer them your solution, don't you?
 
Upvote 0
Here is the code that I have that works for me.

VBA Code:
Sub send_email_with_table_as_pic_2()

Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc


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

'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Summary Report")
Set table = ws.Range("A12:L58")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste

pic.Select
    With Selection
        .ShapeRange.LockAspectRatio = msoTrue
        .ShapeRange.Height = 1000
        '.ShapeRange.Width = 2000
End With

pic.Cut

'create email message
On Error Resume Next
    With OutMail
        .To = Range("B1").Value
        .cc = Range("B2").Value
        .Subject = Range("B3").Value
        .Body = Range("B4").Value & Format(Date, "mm-dd-yy")
        .Display
       
    ' creates attachment of worksheet and adds to email
    .Attachments.Add ActiveWorkbook.FullName
       
        Set wordDoc = OutMail.GetInspector.WordEditor
            With wordDoc.Range
                .PasteandFormat wdChartPicture
                .insertParagraphAfter
                .insertParagraphAfter
                .InsertAfter "Thank you,"

            End With
           
        .HTMLBody = "<BODY style = font-size:15pt; font-family:Calibri>" & _
            "Hi Team, <p> Please see snapshot of current Action Items: <p>" & .HTMLBody
    End With
    On Error GoTo 0
   
Set OutApp = Nothing
Set OutMail = Nothing

End Sub
 
Last edited by a moderator:
Upvote 0
Solution

Forum statistics

Threads
1,224,816
Messages
6,181,139
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top