VBA- Copy & Paste Range into Outlook as a Picture

T

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: 72
  • 2024-04-11_14-08-48.jpg
    2024-04-11_14-08-48.jpg
    177.8 KB · Views: 74

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
136
mumps
mumps
K
  • Question Question
Call cell value Macro
Replies
1
Views
204
karldugan
K
K
  • Solved
Macro : Email Worksheet As PDF
Replies
3
Views
415
Domenic
D
B
  • Question Question
font size in outlook email (12 points doesn't work)
2
Replies
13
Views
288
basb87
B
T
  • Solved
VBA HTML email formatting
Replies
2
Views
319
Micron
M

Forum statistics

Threads
1,223,885
Messages
6,175,183
Members
452,615
Latest member
bogeys2birdies

Share this page

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